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A  SYSTEM  FOR  INTERACTIVE  COMPUTER  CONTROL  OF  EXPERIMENTS 


Introduction 

An  integrated  system  allowing  computer  control  and  data 
acquisition  has  been  developed  for  the  7TRL  quasi-optical  gyrotron 
experiment.  The  motivation  for  this  system  is  manyfold.  First,  it 
is  necessary  to  simultaneously  monitor  several  parameters;  a 
difficult  task  using  only  oscilloscopes  but  simple  for  a  computer. 
Secondly,  a  computerized  system  is  potentially  much  more  accurate 
than  an  experimenter  reading  numbers  off  of  an  oscilloscope  and 
recording  them  in  a  notebook.  The  use  of  the  computer  allows  the 
experimenter  to  visually  monitor  only  the  parameters  of  immediate 
interest  while  the  computer  quietly  records  all  of  the  necessary 
data  for  future  analysis.  Additionally,  since  the  data  is  already 
in  the  computer,  data  analysis  and  plotting  is  transformed  into  a 
process  that  takes  a  few  minutes  instead  of  large  fractions  of 
hours.  Because  aich  of  this  analysis  can  be  done  while  the 
experiment  is  running,  the  taking  of  useless  data  can  be  held  to  a 
minimum.  These  facts  all  result  in  the  ability  to  take  much  more 
complete  and  accurate  data  in  a  shorter  time  period  than  otherwise 
would  be  possible. 

The  quasi-optical  gyrotron  experiment  for  which  this 
system  was  developed  is  a  pulsed,  repeatable  experiment.  Thus 
provision  has  been  made  to  average  the  data  over  a  number  of 
different  shots.  Data  to  be  taken  falls  into  two  broad  categories. 
First  is  the  data  for  which  the  entire  wave  form  is  desired, 
requiring  a  transient  digitizer  for  each  channel.  Pulse  lengths 
vary  between  1  and  20  microseconds,  so  the  software  was  written  to 
digitize  only  the  necessary  time  interval  in  order  to  avoid 
recording  useless  data  during  the  shorter  pulses.  An  example  of 
this  type  of  data  is  the  output  microwave  pulse  shape  of  the 
experiment.  The  second  type  of  data  to  be  taken  requires  only  a 
single  data  point  to  be  recorded  each  pulse.  This  is  appropriate 
for  parameters  that  do  not  change  during  the  pulse  such  as  the 
cavity  magnetic  field.  Since  this  type  of  data  requires  very 
little  storage  space,  virtually  every  experimental  parameter  can 
be  measured  and  stored  each  pulse. 

The  software  portion  of  this  system  was  adapted  from  the 
PIC AX  program  written  by  Robert  Wal raven.  This  provided  the  basic 
structure  of  the  program,  and  only  needed  to  be  converted  into  a 
program  capable  of  running  on  the  I?M  PC-XT.  In  addition,  all  of 
the  experiment  specific  software  such  as  the  data  taking, 
plotting,  analysis,  storage  ar.d  experimental  parameter  control  had 
to  be  developed.  The  users  manual  for  the  original  °TCAX ,  version 
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1,  is  attached,  as  is  the  manual  and  source  listing 
current  implementation ,  version  2.  A  short  example  of 
ran' s  usage  i3  also  attached. 


the  crce- 


Figure  1  shovs  a  schematic  of  the  hardware  that  is 
interfaced  vith  the  software.  The  IBM  BC-X™  is  clearly  the  trains 
of  the  system,  and  communicates  vith  the  CAMAC  crate  through  the 
crate  controller.  A  vide  variety  of  plug-ins  is  available  for  the 
crate,  all  of  vhich  can  be  controlled  through  the  controller,  '"he 
transient  digitizers  record  the  vaveform  data  from  the  experiment 
vhile  the  digital  to  analog  converter  is  used  to  control  different 
pieces  of  the  experimental  apparatus.  Additional  capability  is 
provided  by  the  Data  Translation  DT2fl01  card  vhich  is  used  for  its 
digital  input  and  output  as  veil  as  for  recording  the  single  point 
data  from  the  experiment.  To  ensure  that  the  data  recorded  all 
corresponds  to  the  same  point  in  time,  each  piece  of  single  point 
data  is  held  in  a  fast  sample  and  hold  circuit,  and  these  are 
simultaneously  triggered  by  a  single  trigger  pulse.  For  accurate 
triggering  and  repetition  rates  an  external  pulse  generator  is 
used  to  trigger  both  the  experiment  and  the  diagnostics. 
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Robert  Walraven 
Department  of  Applied  S 
University  of  California 
3  December  19^1 
Program  version  1. 


ienc  e 
Davis 


The  PICAX  program  was  born  in  the  laboratory.  An  embry¬ 
onic  version,  written  in  19‘7<^  ,  was  used  for  control  and  data 
acquisition  for  an  experiment  in  plasma  physics.  Soon  this 
early  version  was  modified  to  be  used  with  other  unrelated  ex¬ 
periments;  it  satisfied  many  needs  that  seem  to  be  universal¬ 
ly  desirable  in  any  program  for  control  and  data  acquisition, 
namely , 

*  Interactive  control 

*  User-controllable  data  acquisition 

*  Storage  and  retrieval  of  data  on  mass  storage 

*  On-line  analysis  of  data 

*  Plotting  of  data  and  analyzed  results 

PICAX,  the  current  version  of  that  early  program,  is  the  re¬ 
sult  of  three  years  of  experience  with  the  needs  of  both  casu¬ 
al  and  advanced  users. 

If  you  are  a  PICAX  user,  send  me  your  name  and  address  sc 
that  I  can  send  you  information  about  problems  and  improve¬ 
ments.  Also,  if  you  have  any  suggestions  about  how  PICAX 
could  be  improved,  please  let  me  know. 


Robert  Valraven 
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INTRODUCTION 


PICAX  is  a  FORTRAN  program  written  for  the  PDP-11  com- 
uter  family  and  the  RT-11  operating  system.  It  is  specifi- 
ally  designed  to  minimise  the  user's  effort  in  programming 
or  applications  in  which  the  computer  is  used  for  laboratory 
ontrol  and  data  acquisition  by  providing  the  following  fea¬ 
tures: 

*  Standard  commands  that  call  user-written  subroutines  to 
control  experiments,  analyze  and  plot  data,  and  read  and 
write  dish  files. 

*  Standard,  simple,  relatively  crashproof  commands  to  OPEN, 
FIND,  and  CLOSE  disk  data  files. 

*  DIR  command  to  produce  directory  listings  on  the  console 
or  line  printer. 

*  Commands  that  may  be  executed  individually  as  they  are 
typed  or  as  a  program  of  several  commands  (with  simple 
looping  capabilities). 

*  User-callable  analysis  subroutines  for  linear  and 
non-linear  fitting,  digital  filtering.  Fast  Fourier 
Transforms,  correlation,  etc.,  available  in  PICLI3  libra¬ 
ry  . 

*  Segmented  structure  suitable  for  efficient  overlaid  pro- 
grammi ng . 

*  Sue  ry  feature  for  detailed  descriptions  of  system  and 
user  co  mma  n  d  s . 


SYSTEM  COMMANDS 


SYSTEM  COMMANDS 


To  use  PICAX,  you  must  first  write  FORTRAN-callable 
subroutines  to  perform  at  least  3ome  of  the  following  opera¬ 
tions  : 


*  Initialize  data  and  experiment 

*  Define  user  variables 

*  Take  data 

*  Analyze  data 

*  Plot  data  and  results 

*  Write  data  to  disk 

*  Read  data  from  disk 

*  Describe  user  commands 


The  user-written  subroutines  must  have  specific  standard 
names,  and  must  be  put  in  object  modules  with  specific  names 
so  that  the  linker  can  place  them  properly  in  the  overlay  pro¬ 
gram  it  creates.  Details  on  writing  the  user  subroutines  are 
given  later. 


Each  command  may  be  followed  by  up  to  four  floating  point 
numbers  in  free  field  format  separated  by  commas.  These 
numbers  are  called  COMMAND  VARIA3LES,  and  are  passed  to  the 
user-written  subroutines  through  labeled  CC  MON. 

Commands  are  executed  in  the  immediate  mode  simply  by 
typing  the  command  code  followed  by  a  list  of  optional  parame¬ 
ter  values.  For  example,  typing 
PLOT  -1,1. 235  ,135 

will  cause  a  user-written  plot  subroutine  to  be  called  with 
the  four  command  variables  set  to  -1.,  1.235*  125,  and  0.0. 

User  variables  are  provided  to  define  parameters  for  the 
user  subroutines  that  you  don't  want  to  specify  every  time  a 
command  is  typed.  For  example,  you  may  wish  to  have  user  var¬ 
iables  to  describe  the  extent  of  the  x-axis  displayed  in  a 
plot,  or  the  value  to  output  to  a  D/A  converter  at  the  start 
of  a  ru n . 

PICAX  recognizes  commands  by  looking  for  a  one  or  two 
letter  code.  For  example,  any  of  the  commands 
DI6 
DIR  6 

DIRECTORY  6 
DIXISCUP  6 

will  produce  a  directory  listing  on  the  line  printer. 
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iIS?  OF  COMMANDS 


3RIEF  LIST  0?  COMMANDS 

The  standard  commands  supported  by  °ICAX  are 

A  Add  to  a  user  variable 

AN  Analyze  data 

CL  Close  the  disk  output  file 

DI  Directory  listing 

DO  Do  loop 

E  Erase  screen 

EX  Exit  program 

FI  Find  an  old  disk  file  for  output 

GO  Go  to  program  line 

HE  Help  the  user  out 

HC  Make  hardcopy  of  screen 

K  Kill  program 

LC  List  commands 

LP  List  program 

LV  List  user  variables 

0  Open  a  new  disk  file  for  output 

PA  Pause 

PL  Plot  data 

PR  Proceed  with  experiment 
R  Read  a  record  from  disk 
S  Start  experiment 
T  Enter  title 
V  Set  a  user  variable 
W  Write  a  record  to  disk 
WA  Wait  in  units  of  10  ms. 

Z  Zero  or  init  data 


If  you  type  a  command  and  PICAX  cannot  find  a  match  wit 
one  of  the  above  commands,  it  will  call  the  user-written  rou 
tine  UMATCE  to  see  if  the  user  has  defined  any  additional  com 
sands. 


DESCRIPTION  OF  COMMANDS 


DESCRIPTION  OF  COMMANDS 

Note:  Square  brackets  !'  are  used  to  indicate  optional 

parameters  for  a  command.  The  brackets  should  not  be  included 
when  the  command  is  actually  typed. 

A  N,R  Adds  the  value  R  to  user  variable  number  N.  For  ex¬ 
ample  , 

A  5, -12.1 

will  add  -12.1  to  user  variable  5. 

AN  Calls  a  user  written  routine  named  UANLYZ  to  analyze 

data.  rJp  to  four  command  variables  may  be  speci¬ 
fied. 

CL  [LU]  Closes  a  disk  file  on  logical  unit  LTJ  if  one  is  open 
for  output.  If  LU  is  not  specified,  logical  unit  2 
is  assumed. 

DI  [ LU !  Produces  a  directory  listing  of  DfC :  .  ’’’he  listing  is 

normally  output  to  the  console,  but 
DI  6 

will  produce  a  listing  on  the  line  printer. 

DO  N ,M  Do  loop  command  for  program  mode.  N  specifies  the 
line  that  ends  the  loop,  and  M  specifies  how  many 
times  to  execute  the  loon.  For  example, 

DO  30.5 

means  DO  to  line  30  five  times. 

E  Erase  screen  (if  console  i3  a  Tektronix  terminal). 

EX  Exit  the  program  (return  to  RT-ll).  PICAX  disables 

control-C  exiting  so  that  the  program  is  forced  to 
perform  any  final  housekeeping  before  stopping. 
Typing  this  command  is  the  only  way  to  get  out  of 
PICAX  . 

FI  [ LU !  Find  an  old  disk  file  for  input  on  logical  unit  LU . 

PICAX  prompts  the  user  for  a  file  name,  finds  the 
file,  reads  the  first  record,  and  rewinds  the  file. 
If  LU  is  not  specified,  3  is  assumed.  TJp  to  n  logi¬ 
cal  -nits  may  be  open  for  input  at  one  time. 

GO  [n!  3egin  the  current  program.  If  N  Is  specified,  the 

program  is  started  at  line  N. 

HE  Help  the  user  out  by  typing  seme  useful  information. 

HC  Make  a  hard  copy  of  the  screen. 

v  Hill  the  current  urogram.  Deletes  all  lines  of  the 

program. 


LC 


List  the  valid  defined  commands,  and 
description  of  each. 


give 


hr  i‘ 


L i3t  the  current  program. 


L  V 


List  the  current  values  of  the  user  variables  and 
give  a  brief  description  of  each  variable. 


0  [  LU]  [  ,!l]  Open  a  new  disk  file  for  output  on  logical  unit  LTJ. 

If  LU  is  not  specified,  2  is  assumed.  PICAX  prompts 
the  user  for  a  file  name,  closes  any  open  files  on 
the  specified  logical  unit,  and  opens  the  new  file. 
R  i3  an  optional  file  size.  If  N>0 ,  a  file  is 
opened  R  blocks  long.  If  R=0  ,  a  file  is  opened  that 
is  equal  in  length  to  half  of  the  largest  free  space 
on  the  specified  device.  If  R=-l  ,  a  file  is  opened 
that  is  equal  in  length  to  the  largest  free  space  on 
the  specified  device.  Up  to  6  logical  units  may  be 
open  for  output  at  one  time. 


M 

PA 

k 

h 

PL 

E 

l 

PR 

R  ( LU ! 


V  U  ,H 


V  [  LU  1 


Waits  until  a  return  is  typed. 


Calls  a  user-written  routine  named  UPLOT  to  plot 
data.  Up  to  four  command  variables  may  be  speci¬ 
fied. 


Proceed  with  the  experimental  data  acquisition  after 
it  has  been  interrupted  by  the  user  typing  some¬ 
thing.  Up  to  four  command  variables  may  be  speci¬ 
fied. 


LIT  by  calling  the 
If  LU  is  not  sueci- 


Read  a  record  from  logical  unit 
user-written  subroutine  UREAD. 
fied,  3  is  assumed.  If  no  file  is  open  for  input  on 
the  specified  logical  unit,  an  error  occurs.  Up  to 
four  command  variables  may  be 
first  must  be  the  LU. 


specified,  but  the 


Start  the  experimental  data  acquisition  by  calling 
the  user-written  subroutine  USTART.  Up  to  four  com¬ 
mand  variables  may  be  specified. 


Enter  title.  PTCAX  will  prompt  the  user  for  a  line 
of  text  to  be  used  as  a  title. 


Set  user  variable  number  R  equal  to  R.  For  example, 
73  12.1 

sets  user  variable  3  to  12.1. 


Write  a  record  to  logical  unit  LU  by  calling  the 
U3er-vritten  subroutine  UWRI^E.  if  LU  is  not  speci¬ 
fied,  2  i3  assumed.  If  no  file  i3  open  for  output, 
an  error  occurs.  :Jo  to  four  command  variables  mav 
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r C?r  C?  COMMANDS 


V  A  M 


be  specified,  bub  the  first  must  be  the  1’J. 

Wait  for  V  tines  10  Billiseconds  before  proceedi 
to  the  next  command 


Zero  data  by  calling  the  user-written  subrouti 
UZ2R0.  Up  to  four  command  variables  nay  be  spec 
fied. 


The  user  may  add  additional  commands  to  this  li3t 
specifying  them  in  the  user-written  routine  UMATCH. 

If  you  do  not  remember  what  a  particular  command  doe 
type  the  command  followed  by  a  question  mark.  PICAX  will  r 
spond  by  giving  you  information  about  the  command. 


PROGRAM  MODS 


PROGRAM  MODS 

Commands  may  be  executed  as  the/  are  t/ped  or  in  a  group 
as  a  program.  If  a  line  number  is  t/ped  before  the  command, 
the  command  is  not  executed  immediately,  but  is  entered  into  a 
program  buffer.  The  following  rules  apply  to  programs: 

1.  A  program  may  be  up  to  50  lines  in  length. 

2.  Line  numbers  may  be  any  number  in  the  range  1  to  999 

3.  Line  numbers  do  not  have  to  be  in  consecutive  order. 

U.  Lines  do  not  have  to  be  typed  in  order;  PICAX  will  auto¬ 
matically  order  the  lines  numerically. 

5.  To  change  a  line,  simply  retype  the  new  line  with  the 
same  line  number. 

6.  To  delete  a  line,  type  the  line  number  only. 

T.  To  delete  the  entire  program,  type  the  command  K. 

8.  To  list  a  program,  type  the  command  LP . 

9.  To  run  a  program,  type  the  command  GO.  To  start  a  pro¬ 
gram  at  a  particular  line  number  that  is  not  the  first 
line  number,  type  the  command  GO  followed  by  the  line 
number. 

The  two  commands  DO  and  GO  allow  simple  looping  possibil¬ 
ities.  A  typical  program  with  looping  might  look  like  this: 

10  0  7 
20  V5  *  10 
30  DO  60,5 
U0  S  5,7 
50  W  7,10.1 
60  A  5,1 
70  CL  7 
80  GO  10 

Line  number  10  opens  a  file  on  logical  unit  7.  Line  20  sets 
user  variable  5  bo  10.  Line  30  causes  lines  Uo  through  60  to 
be  executed  in  a  loop  5  times.  Line  Uo  causes  the 
user-written  subroutine  USTART  to  be  called  with  the  command 
variables  set  to  5«,7.,0.,0.  Line  50  causes  the  user-written 
subroutine  UWRITE  to  be  called  for  logical  unit  T  with  the 
command  variables  set  to  7.,10.1,0.,0.  Line  60  adds  1.  to 
user  variable  5.  Line  70  closes  unit  7.  Line  80  loops  back 
to  the  beginning. 
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PICAX  PROGRAM  PLOW 

The  following  steps  describe  the  program  flow  through 
PICAX  as  it  is  running: 

1.  Initialize  3ICAX.  Call  U INI'". 

2.  Write  a  to  prompt  user. 

3.  If  a  return  (after  a  line  of  input)  or  a  control-C  was 
typed,  go  to  3. 

1*.  If  the  experiment  is  on  (EXPT  OR  =  .TRUE.),  call  UPDATE. 

5.  If  a  program  is  not  running,  go  to  3. 

6.  Execute  the  next  line  of  the  program. 

7.  If  the  program  is  still  running,  go  to  3.  Otherwise,  go 
to  2 . 

8.  Turn  experiment  off  (EXPT  OR  *  .FALSE.).  Turn  program 
off. 

9.  If  no  characters  were  typed,  go  to  2. 

10.  If  a  control-C  was  typed,  write  an  acknowledgement  and 
go  to  2. 

11.  If  the  typed  Input  was  not  intelligible,  write  an  error 
message,  and  go  to  2. 

12.  If  only  a  line  number  was  typed,  delete  that  line  from 
the  program  and  go  to  2. 

13.  If  a  recognizable  command  wa3  not  found,  write  an  error 
message  and  go  to  2. 

1U .  If  there  wa3  a  line  number,  insert  the  line  into  the 
program  and  go  to  2.  Otherwise,  execute  the  command  im¬ 
mediately  and  go  to  2. 

The  logical  variable  EXPT  OR  determines  whether  an  exper¬ 
iment  is  running  or  not.  The  logical  variable  PROG  OR  deter¬ 
mines  whether  a  program  is  running.  These  two  variables  may 
be  accessed  through  the  following  COMMON  block: 

COMMON  /?  FLAGS/  PROG  OR,  EXPT  OR,  QUERY 
LOGICAL  PROG  OR,  EXPT  OR,  QUERY 

The  commands  PR  and  S  set  EXPT  OR  to  true  before  Jumping 
to  their  respective  user-written  subroutines  UPROCD  and 
USTART.  The  command  GO  3ets  °R0G  ON  to  true. 
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UPDATE 

Once  the  experiment  is  turned  on  (EXP T  ON  =  .TRUE."1,  it 

will  stay  on  either  until  the  user  types  a  return  or 

control-C,  or  until  the  user-written  subroutine  UPDATE  turns 
he  experiment  off.  The  commands  PR  and  S  should  only  be  used 
o  get  the  experiment  going.  If  the  experiment  does  need  ser¬ 
vicing,  UPDATE  should  do  whatever  is  required,  and  if  the  ex¬ 
periment  is  over,  EXPT  ON  should  then  be  set  to  false.  In  any 

case,  UPDATE  should  return  so  that  PICAX  can  check  for  input. 
If  there  is  no  input,  UPDATE  will  be  called  again  immediately. 
If  there  is  input,  however,  EXPT  ON  will  be  set  false  and  the 
input  will  be  processed  by  PICAX.  The  experiment  can  be  con¬ 
tinued  by  typing  PR  or  restarted  by  typing  S. 

Some  experiments  must  be  serviced  rapidly,  so  the  user 
may  not  wish  to  return  to  PICAX  until  the  experiment  is  done. 
In  this  case  the  experiment  cannot  be  interrupted  by  keyboard 
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OVERLAY  STRUCTURE 

PICAX  is  too  large  to  fit  in  memory  without  using  an 
overlay  structure;  this  is  primarily  due  to  the  inclusion  of 
the  AG-II  graphics  package.  The  overlay  structure  has  been 
carefully  designed  to  optimize  the  interactive  response  on  a 
floppy-disk  system.  The  overlay  structure  of  PICAX  consists 
of  a  root  module  and  four  overlay  regions.  The  file  PICAX.COM 
is  a  command  file  that  performs  the  overlay  linkage.  All  mo¬ 
dules  beginning  with  "PICAX”  contain  PICAX  subroutines.  All 
modules  beginning  with  "AG2"  are  part  of  the  AG-II  graphics 
system.  The  user-written  routines  should  be  placed  in  the  mo¬ 
dules  USERR,  USER1,  USER2 ,  and  USER3  as  follows: 

USERR:  UPDATE,  UPLOT 

USER1 :  UANLYZ ,UINIT,UPROCD , UREAD  , 

USTART ,UVLIST ,UWRITE , UZERO 
USER2:  U MATCH ,  UCMNDS.UISFO 

USER3 :  QUANAL  ,QUPL0T , QUPROC , QUREAD  , 

QUSTRT ,QUWRIT,QUZERO 

USERR  i 3  a  root  module,  and  should  contain  any  routines 
associated  with  fast  data  taking.  That  is  why  UPDATE  is  put 
there.  The  subroutine  UPLOT  is  also  placed  in  the  root  seg¬ 
ment  because  all  AG-II  graphics  routines  that  it  might  call 
are  in  the  overlay  modules.  The  module  USER1  contains 
user-written  subroutines  that  respond  to  various  commands. 
The  module  USER2  contains  subroutines  for  defining  any  addi¬ 
tional  commands  that  the  user  wishes  to  supply.  USER3  con¬ 
tains  help  information  about  the  user-written  commands. 


Modules  with  the  names  USERR. SKL,  USER1.SKL,  USER2.SKL, 
and  USER3.SKL  contain  skeleton  versions  of  all  the  required 
U3er-written  subroutines,  so  that  you  only  have  to  write  the 
subroutines  that  are  required  by  your  specific  needs. 
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The  module  RICLIB.FOR  contains  a  number  of  subroutines 
that  are  of  interest  in  a  data  acquisition  and  analysis  envi¬ 
ronment,  and  that  may  be  called  by  the  required  user  subrou¬ 
tines.  The  subroutines  in  PICLI3.F0R  are 


FILTER  -  A  general  non-recursive  filter  that  may  be  used 
to  perform  lovpass,  bandpass,  highpass,  and 
bandstop  filtering  of  data. 


KAISER  -  A  subroutine  required  by  FILTER. 


BESIO  -  A  subroutine  required  by  FILTER  that  computes  the 
zero-th  order  modified  bessel  function  l(x). 


H  OF  Z  NR  -  Computes  the  transfer  function  of  a 
non-recursive  filter. 


CURFIT  -  Performs  a  least-squares  fit  to  a  user-spec i f i ed 
non-linear  function. 


FCHISQ  -  A  subroutine  required  by  CURFIT. 


MATITV  -  A  subroutine  required  by  CURFIT  that  computes 
the  inverse  of  a  symmetric  matrix. 


FAST  -  Performs  a  fa3t  fourier  transform  of  data. 


The  documentation  for  these  subroutines  is  provided  in 
the  source  listings. 
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The  advanced  graphics  package  ^AG-Il)  i3  functionally 
equivalent  to  the  Tektronix  Plot  10  advanced  graphics  package. 
However,  it  has  "been  written  to  run  faster  and  to  fit  on  an 
LSI-11  by  making  use  of  the  RT-11  overlay  structure.  Sources 
and  command  files  for  preparing  the  AG-II  overlay  modules  are 
available  from  Tektronix  Plot-10  Software  Marketing:  contact 
Will  Gallant  at  (503)  682-3^11,  ext.  37B5.  You  may  obtain  a 
manual  for  the  package  from  your  local  Tektronix  office  (Manu¬ 
al  part  no.  070-224U-00 )  . 
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EXAMPLE  USER  SUBROUTINES 

Let's  look  at  how  PICAX  could  he  used  in  a  typical  labo- 
atory  situation.  Suppose  you  want  to  write  a  program  to  con- 
rcl  an  experiment  that  is  interfaced  to  a  DRVll  lo-hit  digi¬ 
tal  input/output  card  at  address  l67770.  Further,  suppose  you 
would  like  the  program  to  do  the  following: 

1.  At  the  start  of  the  experiment,  load  the  output  register 
with  0. 

2.  Turn  on  bit  15  of  the  output  register.  Suppose  a  posi¬ 
tive  transition  of  this  bit  i3  used  to  enable  the  exter¬ 
nal  experiment. 

3.  Wait  until  the  DRVll  status  register  (bit  7)  goes  high, 
indicating  that  data  is  ready.  Then  read  the  data. 

U.  Turn  off  bit  15  of  the  output  register. 

5.  If  128  data  points  have  been  collected,  stop  the  experi¬ 
ment.  Otherwise  increment  the  output  register  and  go  to 
step  2. 

6.  After  data  taking  is  over,  allow  the  user  to  filter  the 
data,  plot  it,  and  write  raw  data  to  disk. 

7.  Let  the  program  read  data  from  disk,  so  that  the  data 
can  be  analyzed  at  some  later  time. 

We  will  define  a  labeled  common  to  pass  variables  among 
the  user  subroutines: 

COMMON  /DEMO/  NDATA  ,  DATA ( 12s),  NRUNS 

where  NDATA  i3  the  number  of  the  next  data  point  to  be  obta¬ 
ined  from  the  experiment,  DATA  is  an  array  to  store  the  accu¬ 
mulated  data,  and  NRUNS  is  the  number  of  accumulated  runs  if 
new  data  is  added  to  the  data  already  in  the  array  DATA. 

The  required  user  subroutines  for  this  task  are  shown 
below.  These  subroutines  interact  with  PICAX  through  labeled 
commons : 

1.  The  command  variables  that  follow  a  command  may  be  picked 
up  with 

COMMON  /?  C  VAR/  N  C  VAR,  CVAR(l) 
where  CVAR(l)  through  CVAR(U)  are  up  to  four  command  var¬ 
iables  that  follow  the  command. 
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2.  The  PICAX  logical  variable  EXPT  ON  mist  be  set  false  in 
the  user  subroutine  UPDATE  when  data  taking  is  over. 
EXPT  ON  is  referenced  through 

COMMON  /?  FLAGS/  ^ROG  ON,  EXPT  ON,  CUERY 
LOGICAL  PROG  ON,  EXPT  ON,  QUERY 

3.  The  title,  if  any,  defined  by  the  T  command  may  be  obta¬ 
ined  from 

COMMON  /P  TITLE/  LTITLE(3^) 

U.  The  user  variables  may  be  obtained  from 

COMMON  / U  VAR  /  N  U  VAR,  U  VAR ( 1 ) 
where  N  U  VAR  is  the  total  number  of  user  variables.  The 
user  variables  should  be  set  to  their  initial  values  in 
user  subroutine  UINIT.  For  convenience,  the  correct  di¬ 
mension  for  UVAR  need  only  appear  in  UINIT,  since  the 
linker  will  set  the  length  of  the  labeled  common  UVAR 
equal  to  its  longest  occurance.  Everywhere  else  UVAR  may 
be  dimensioned  1. 

The  example  user  subroutines  contain  extensive  documenta¬ 
tion  that  is  applicable  to  their  use  in  PICAX,  so  it  is  recom¬ 
mended  that  the  user  read  through  these  subroutine  listings 
carefully. 
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SUBROUTINE  UPDATE 

■User  root  routine  to  service  experiment.  If  the  S  command  was 
•typed  with  the  first  command  variable  non-zero,  the  new  data  i 
■added  to  DATA,  otherwise  it  replaces  DATA. 

COMMON  /DEMO  /  N  DATA,  DATA(l28),  N  RUNS 
COMMON  /P  C  VAR/  N  C  VAR,  C  VAR(l) 

COMMON  /P  FLAGS/  PROG  ON,  EXPT  ON,  QUERY 
LOGICAL  PROG  ON,  EXPT  ON,  QUERY 

•Return  to  PICAX  if  no  data  available  yet 
IF  (  (  IPEEK("l67770  )  .AND. ”200  )  .EQ.O)  RETURN 


VALUE  =  IPEEK( ”16777^ )  !Ge 
•If  CVAR(l)  is  zero,  store  it  in  the 
•add  it  to  the  data  array. 

IF  (CVAR(l) .EQ.O.)  DATA  ( NDATA)  =  V 
IF  (CVAR(l).NE.O.)  DATA  (NDATA)  *  D 
I  *  IPEEK  (  "167772 )  .AND.  "77777  .'  Tu 
CALL  IPOKE( "167772  ,1) 

IF  ( NDATA.  EQ. 128)  GO  TO  10  ! Ju 
NDATA  *  NDATA  +1  ! In 
CALL  IP0KS( "167772 , NDATA) 

CALL  IPOKE ( "167772  , NDATA. OR. "100000 
RETURN 


!Get  next  data  point 

the  data  array.  Otherwise 


=  VALUE 

*  DATA  (NDATA)  + 
.'Turn  bit  15  off 


VALUE 


'.Jump  to  10  if  done 
SIncrement  output  register 

D00)  .'Turn  bit  15  on 


10  EXPT  ON  *  .FALSE. 

N  RUNS  =*  N  RUNS  +•  1 
RETURN 


!Turn  experiment  off 
Ilncrement  run  count 
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SUBROUTINE  UPLOT 

- User  routine  to  plot  data.  If  a  nonzero  command  variable  is 

- entered,  the  first  and  second  user  variables  a  re  used  as  the 

- lover  and  upper  limits  of  the  y  axis. 

COMMON  /DEMO  /  N  DATA,  DATA (128),  N  RUNS 
COMMON  /P  C  VAR/  N  C  VAR,  C  VAR(l) 

COMMON  /P  TITLE/  LTITLE(36) 

COMMON  /U  VAR  /  N  U  VAR,  U  VAR(l) 

DIMENSION  X(U),Y(129) 

DATA  X/-1. ,128.  ,1.  ,1./ 

CALL  BINITT  Unitialize  AG-II  graphics 

CALL  ERASE  !Erase  screen 

CALL  MOVABS  (100,725)  ! Move  to  top  of  graph 

CALL  HTEXT  (LTITLE)  JPrint  title,  if  any 

IF  (CVAR( 1 ) .NE.O . )  ! I f  command  variable  1  is  not  zero, 

1  CALL  DLIMY(UVAR(3) ,UVAR(U ) )  !set  y-axis  limits 

Y(l)  *  128  !Set  number  of  pts  in  plot  array 

DO  10  1*1,128  !Load  data  in  plot  array 

10  Y ( 1+1 )  =  DATA(I) 

CALL  CHECK  (X,Y)  'Plot  data 

CALL  DSPLAY ( X , Y ) 

CALL  MOVABS  (0,750)  !Move  to  upper  left  of  screen 

CALL  ALFMOD  !Enter  alphanumeric  mode 

RETURN 
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USER1.FOR:  PICAX  user  module  for  overlay  region  1 

♦•a***#****#*#*###**#*##*#######*##**##*########**#****###***# 

SUBROUTINE  UANLYZ 


Pass  data  through  a  digital  filter 

COMMON  /DEMO  /  N  DATA,  DATA ( 128),  N  RUNS 
COMMON  /P  C  VAR /  N  C  VAR,  C  VAR(l) 

COMMON  /U  VAR  /  N  U  VAR,  U  VAR ( 1 ) 

DIMENSION  COEF(IO),  TEMP(lO) 

IF  ( CVAR ( 1 ) . NE . 0 .  .OR.  CVAR ( 2 ) . NE . 0 . )  GO  TO  10 
FLOW  a  UVAR(l)  !Get  lower  cutoff 

FHIGRa  UVAR(2)  IGet  upper  cutoff 

GO  TO  20 

10  FLOW  a  CV AR ( 1 )  !Use  command  variables 

FHIGH®  CVAR(2)  !  for  cutoffs 

20  I  FLAG  a  o 

CALL  FILTER  ( DATA , DATA , 128 .FLOW ,FHIGR , 50 ., COEF ,TEMP , 10 , IFLAG ) 
RETURN 
D 

SUBROUTINE  UINIT 

Initialize  user  data  and  variables 


COMMON  /U  VAR  /  N  U  VAR,  U  VAR(U) 


CALL  UZERO 
N  U  VAR  »  4 
U  VAR  (1)  » 
U  VAR  (2)  a 
U  VAR  (3)  » 
U  VAR  (U)  a 
RETURN 


!Zero  user  data 
!Number  of  user  variables 
ILower  filter  cutoff 
lUpper  filter  cutoff 
ILower  limit  of  y-axis 
lUpper  limit  of  y-axis 
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C - 

SUBROUTINE  UREAD  (LUN) 

COMMON  /DEMO  /  NDATA ,  DATA ( 123 ), NRUNS 
COMMON  /?  TITLE/  LTITLE(36) 

COMMON  / U  VAR  /  N  U  VAR,  U  VAR ( 1 ) 

If  LUN  is  negative,  it  is  the  first  read  for  the  file, 
so  Just  read  in  the  title  and  user  variables. 

IF  (LUN.GT.O)  GO  TO  10 
LUN  *  -LUN 

READ  ( LUN  ,END=200 )  NUVAR ,LTITLE 
READ  (LUN,END=200)  (U  V AR ( I ) , 1*1 , NUVAR ) 

RETURN 

10  READ  (LUN,END*200  )  NRUNS,  DATA ( 128) 

RETURN 

200  WRITE  (5,30) 

30  FORMATC  End  of  file') 

RETURN 
END 


SUBROUTINE  USTART 

Start  the  experiment,  then  return  to  PICAX. 

CALL  IPOKE  ( "167772 ,0 )  ! Clear  output  register 

CALL  IPOKE  ("167772, ”100000)  IFlip  bit  15  on 

CALL  IPOKE  (”167772,0)  !  and  off 

RETURN 
END 

C - 

SUBROUTINE  UVLIST 
C 

C  Thi3  subroutine  passes  information  to  PICAX  about  the  user 

C  variables  by  calling  the  PICAX  subroutine  DEFINE.  The  first 

C  argument  is  the  variable  number.  The  second  argument  is 

C  'I'  or  'R'  depending  on  whether  the  LV  (list  variables) 

C  command  should  type  an  integer  or  real  value  for  that  variable. 

C  The  third  argument  is  a  descriptive  string  for  the  variable. 

C 

CALL  DEFINE  ( 1 ,' R Lower  cutoff  of  filter') 

CALL  DEFINE  ( 2 , ' R ’ , ' Upper  cutoff  of  filter') 

CALL  DEFINE  ( 3 , ' I ' , ' Lower  limit  of  y-axis’) 

CALL  DEFINE  ( h  ,  • I »  ,  • Upper  limit  of  y-axis') 

RETURN 

END 
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SUBROUTINE  UWRITE  (LUN) 

COMMON  /DEMO  /  N  DATA,  DATA(l28),  N  RUNS 
COMMON  /?  TITLE/  LTITLE( 3o ) 

COMMON  /U  VAR  /  N  U  VAR,  U  VAR ( 1 ) 

If  LUN  is  negative,  it  is  the  first  vrite  to  the  file,  so  Just 
write  the  title  and  user  variables. 

IF  (LUN.GT.O)  GO  TO  10 
LUN  =  -LUN 

WRITE  (LUN,ERR=20  ,SND=Lo)  N  U  VAR,  LTITLE 
WRITE  (  LUN  ,  ERR*  20  ,  END  =  1*0 )  (U  VAR  (  I )  ,  1  =  1  ,  NUVAR  ) 

RETURN 

10  WRITE  ( LUN , ERR=20 ,END=UO )  N  RUNS,  DATA(l23) 

RETURN 

20  WRITE  (5,30) 

30  FORMAT ( '  Error  on  write') 

RETURN 

UO  WRITE  (5,50) 

50  FORMAT  ('  End  of  file’) 

RETURN 


SUBROUTINE  UZERO 


Zero  user  dat* 

COMMON  /DEMO 
N  DATA  *  1 
N  RUNS  =  0 
DO  10  1=1,128 
DATA(I)  =  0. 
RETURN 
END 


/  N  DATA,  DATA (128),  N  RUNS 
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USER2.F0R:  PICAX  user  module  for  overlay  region  2 

4444444444444444444444444444444444444444444444444444444444444444444 

SUBROUTINE  UMATCH 

C 

C  The  user  may  define  additional  commands  beyond  the  standard 

C  ones.  Two  additional  dummy  commands  UA  and  U3  are  added  here 

C  to  illustrate  how  this  is  done.  Commands  are  defined  by 

C  calling  the  PICAX  logical  function  MATCH  as  shown  below. 

C  The  first  argument  is  a  command  number  (greater  than  26). 

C  The  second  argument  is  the  two  letter  string  that  will  cause 

C  PICAX  to  call  the  command.  The  third  argument  is  a  descriptive 

C  string  for  the  command. 

C 

IF  ( MATCH ( 27 , 'UA' Dummy  user  command  A'))  RETURN 
IF  ( MATCH( 28 ,  ’ UB Dummy  user  command  B’))  RETURN 
RETURN 


SUBROUTINE  UCMNDS  (N) 

This  subroutine  i3  called  by  PICAX  when  a  user  command  is 
typed.  N  is  the  number  of  the  command  corresponding  to  the 
number  given  in  UMATCH. 


IF  (N.EQ.27)  WRITE  (5,10) 

IF  (N.EQ.28)  WRITE  (5,20) 

10  FORMAT ( ’  Dummy  user  command  A  called’) 
20  FORMAT ( 1  Dummy  user  command  B  called’) 
RETURN 


SUBROUTINE  UINFO  (N) 

This  subroutine  is  called  by  PICAX  when  a  user  command  is 
followed  by  a  question  mark.  It  should  write  out  some 
helpful  information  about  the  command. 

IF  (N.EQ.27  .OR.  N.EQ.2*)  WRITE  (5  ,10 ) 

10  F0RMAT( ’  This  user  command  does  not  do  anything. ’ ) 

RETURN 


O  O  O  O  O  o 
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#**######»##»#»##*»»#*#*#########*#**#####*###*#*####**■»•*##*##***■*# 

USER3.FOR:  PICAX  user  module  for  overlay  region  3 

*****»«**#«*»***##****»ft»»#*ft«**#**#**»*****ft*»***«****»***4******* 

SUBROUTINE  QUANAL 
WRITE  (5,10) 

10  FORMAT ( '  Performs  digital  filtering  of  data.  If  no  command'/ 

1  '  variables  are  specified,  user  variable  1  is  used  for  the'/ 

2  '  lower  cutoff  and  user  variable  2  is  used  for  the  upper’/ 

3  '  cutoff.  If  command  variables  are  specified,  command'/ 

4  '  variable  1  is  used  for  the  lower  cutoff,  and  command'/ 

5  '  variable  2  is  used  for  the  upper  cutoff') 

RETURN 

END 

C - 

SUBROUTINE  QUPLOT 
WRITE  (5,10) 

10  FORMAT ( '  Plots  the  data.  If  no  command  variable  is  given,'/ 

1  '  automatic  scaling  of  the  y-axis  is  performed.  If  a'/ 

1  '  automatic  scaling  of  the  y-axis  is  performed.  If  a'/ 

2  '  non-zero  command  variable  is  specified,  user  variable  3'/ 

3  '  is  used  for  the  lower  limit  of  the  y-axis,  and  user'/ 

4  '  variable  4  is  used  for  the  upper  limit  of  the  y-axis.’) 
RETURN 

END 

C - 

SUBROUTINE  QUPROC 
WRITE  (5,10) 

10  F0RMAT( '  Proceed  with  the  experiment.') 

RETURN 

END 

C - 

SUBROUTINE  QUREAD 
WRITE  (5,10) 

10  FORMAT ( '  Read  a  data  record  from  disk.') 

RETURN 

END 

C - 

SUBROUTINE  QUSTRT 
WRITE  (5,10) 

10  FORMAT  ('  Start  data  taking.  If  no  command  variable  is'/ 

1  '  specified,  the  new  data  overwrites  the  contents  of  the'/ 

2  '  data  array.  If  a  non-zero  command  variable  is  specified,'/ 

3  '  the  new  data  is  added  to  the  contents  of  the  data  array.') 
RETURN 
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Building  a  PICAX  Program 
To  create  a  PICAX  program,  follow  these  steps: 

1.  The  objects  for  the  overlay  version  of  the  Advanced 
Graphics  Package  should  be  on  SY :  .  If  they  are  not,  cre¬ 
ate  them  and  put  them  there.  (See  the  Advanced  Graphics 
Package  README  file.)  If  there  is  not  sufficient  room  on 
SY :  ,  and  they  must  be  located  elsewhere,  then  modify  the 
command  file  PICAXL.COM  appropriately. 

2.  The  objects  for  PICAX  should  be  on  DK:.  If  they  are  not, 
compile  the  source  files  and  put  the  objects  there. 
( PICAXR . FOR  ,  PICAX1 . FOR  ,  PICAX2 . FOR  ,  PICAX3  . FOR  , 
DIREC . FOR ,  I0FILE . FOR ) 

3.  Modify  the  skeleton  user  modules  USERR.SKL,  USER1.SKL, 
USER2.SKL,  and  USER3«SKL  as  needed  for  your  application. 
Compile  the  resulting  sources  and  put  them  on  DK:. 

L.  Run  the  command  file  PICAXL.COM  to  link  the  program  to¬ 
gether.  The  resulting  file  is  PICAX. SAV. 
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PREFACE  TO  VERSION  1.0 


The  PIC AX 
version , 


program  vas  born  in  the  laboratory.  An  embry¬ 
onic  version,  written  in  197^,  was  used  for  control  and  data 
acquisition  for  an  experiment  in  plasma  physics.  Soon  this 
early  version  was  modified  to  be  used  with  other  unrelated  ex¬ 
periments;  it  satisfied  many  needs  that  seem  to  be  universal¬ 
ly  desirable  in  any  program  for  control  and  data  acquisition, 
namely , 


» 

* 

* 

* 

» 


Interactive  control 

User-controllable  data  acquisition 

Storage  and  retrieval  of  data  on  mass  storage 

On-line  analysis  of  data 

Plotting  of  data  and  analyzed  results 


PICAX,  the  current  version  of  that  early  program,  is  the  re¬ 
sult  of  three  years  of  experience  with  the  needs  of  both  casu¬ 
al  and  advanced  users. 


If  you  are  a  PICAX  user,  send  me  your  name  and  address  so 
that  I  can  send  you  information  about  problems  and  improve¬ 
ments.  Also,  if  you  have  any  suggestions  about  how  PICAX  could 
be  improved,  please  let  me  know. 


Robert  Walraven 
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This  version  of  the  PICAX  program  has  been  modified  from 
the  original  to  run  on  the  IBM  PC-XT  personal  computer  under  the 
PC-DOS  operating  system.  The  user  modules  have  also  been  writen 
for  the  NHL  Quasi-opt ical  Gyrotron  Experiment,  although  they  ar 
sufficiently  general  that  they  should  be  of  general  use  wit 
little  or  no  alteration.  I  would  like  to  thank  Robert  Walraven  for 
the  free  use  of  the  original  code,  without  which  this  would  have 
been  a  much  more  time  consuming  project.  Re  can  be  contacted  at: 


Dr.  Robert  Walraven 
Department  of  Applied  Science 
University  of  California,  Davis 
Davis,  California  95^16 


Tom  Hargreaves 
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INTRODUCTION 

This  version  of  PICAX  is  vritten  in  Microsoft  FORTRAN  for 
use  on  an  IBM  PC- XT  using  the  PC -CCS  operating  system. 
Furthermore,  the  user  subroutines  have  been  vritten  specifically 
for  use  on  the  NRL  Quas i-opt ical  Gyrotron  experiment,  however,  the 
program  should  be  useful  in  a  vide  variety  of  experiments  with 
little  or  no  modification.  PICAX  in  its  current  state  has  the 
following  features: 

*  Data  acquisition. 

*  Data  analysis. 

*  Data  storage. 

*  Data  plotting. 

*  On  line  help. 

*  No  overlay  structure. 

The  theory  behind  this  implementation  of  PICAX  is  to  measure  all 
of  the  relevant  experimental  parameters  simultaneously.  Of  course, 
care  must  be  taken  to  ensure  that  the  computer  knows  which  channel 
of  the  data  acquisition  system  corresponds  to  each  parameter. 

This  manual  is  designed  to  be  used  in  conjunction  with 
the  USERS  MANUAL  for  PICAX  version  1.0. 
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SYSTEM  COMMANDS 


The  system  commands  are  described  in  detail  in  the  PICAX 
Users  Manual  for  version  1.0.  Here  is  a  brief  listing  of  the 
commands  supported  by  PICAX: 


A  Add  to  a  user  variable 
AN  Analyze  data 
CL  Close  the  disk  output  file 
*  D I  Directory  listing 
DO  Do  loop 
E  Erase  screen 
EX  Exit  program 

FI  Find  an  old  disk  file  for  output 

GO  Go  to  program  line 

HE  Help  the  user  out 

HC  Make  hardcopy  of  screen 

K  Kill  program 

LC  List  commands 

LP  List  program 

LV  List  user  variables 

0  Open  a  new  disk  file  for  output 

PA  Pause 

PL  Plot  data 

PR  Proceed  with  experiment 
R  Read  a  record  from  disk 
S  Start  experiment 
T  Enter  title 
V  Set  a  user  variable 
W  Write  a  record  to  disk 
WA  Wait  in  units  of  10  ms. 

Z  Zero  or  init  data 

*  This  command  is  not  currently  implemented  in  PICAX  version  2.0. 

Note  that  any  command  followed  by  a  question  mark  and  a 
return  will  cause  the  on  line  help  package  to  print  out  detailed 
information  covering  the  use  of  the  command  in  question. 
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USER  COMMANDS 


There  is  currently  only  one  user  written  command: 

TR  Trigger  on/off 

This  command  sets  bit  0  of  port  0  on  the  Data  Translation 
her  high  (5  volts)  or  low  (0  volts)  depending  on  the 
that  follows  the  command.  This  signal  can  then  be  used  to 
a  relay  in  the  trigger  line  to  cut  off  the  trigger  pulse 
xperiment . 
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USER  CAPABILITIES 


The  user  subroutines  have  been  written  to  enable  the  user 
to  perform  a  wide  variety  of  tasks,  the  most  important  being  the 
logging  of  experimental  data.  The  intent  is  to  measure  various 
voltages  of  interest  in  a  pulsed  experiment,  typically  1-30 
microseconds  in  duration.  There  are  two  types  of  voltage  data  to 
be  recorded.  First  are  the  channels  for  which  the  entire  wave  form 
is  to  be  recorded,  such  as  the  cathode  voltage  or  the  collector 
current.  Second  are  the  channels  for  which  a  single  point  during 
the  pulse  is  desired.  An  example  of  this  type  of  data  is  the 
current  in  any  of  the  magnetic  field  coils  or  the  calorimeter 
vol tage. 

The  second  type  of  data  is  taken  with  the  use  of  a 
multi-channel  sample  and  hold  unit  fed  into  a  Data  Translation 
DT2801  multi-channel  data  acquisition  card  plugged  into  one  of  the 
expansion  slots  in  the  IBM  PC-XT.  The  sample  and  hold  unit  can  be 
triggered  simultaneously  so  that  the  data  that  the  computer 
retrieves  all  correspond  to  the  same  point  in  time.  The  DT2801 
then  reads  the  data  one  channel  at  a  time  from  the  sample  and  hold 
unit  into  the  memory  of  the  IBM  PC-XT.  A  maximum  of  16  channels 
have  been  developed  for  this  type  of  data. 

A  Transiac  Z008F  transient  digitizer  is  used  to  record 
the  total  waveform  of  the  appropriate  data.  Currently  there  are 
three  actual  channels  of  hardware,  but  the  software  is  set  up  for 
as  many  as  5  channels  and  can  easily  be  expanded.  During  the 
experimental  pulse  the  data  is  stored  in  the  internal  memory  of 
each  transient  digitizer,  which  resides  physically  in  a  CAMAC 
crate.  The  data  can  then  be  read  into  the  memory  of  the  IBM  PC-XT 
through  an  interface  card  in  an  expansion  slot  of  the  computer 
which  is  connected  to  a  controller  in  the  crate  itself.  This  data 
transfer  is  set  up  to  proceed  in  the  DMA  mode. 

In  addition  to  the  transient  digitizers,  there  is  also  a 
LeCroy  8102  six  channel  variable  attenuator  in  the  CAMAC  crate.  By 
telling  the  computer  which  data  points  are  connected  to  each 
attenuator  channel,  the  computer  can  calculate  the  correct 
voltages  for  the  various  data.  The  attenuator  values  are  read  by 
the  computer  through  the  crate  controller  each  time  an 
experimental  run  is  started. 

8esides  the  attenuators  there  is  a  single  channel 
Transiac  1020  differential  amplifier  which  can  also  be  read  by  the 
computer  through  the  crate  controller.  This  allows  amol i f i cati on 
of  weak  signals  to  voltages  appropriate  to  be  measured  by  the 
various  analog  to  digital  converters. 
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Once  the  data  is  in  the  memory  of  the  computer  it  is 
desirable  to  store  it  on  the  10  MB  hard  disk  of  the  I3M  PC-XT. 
This  is  accomplished  in  the  PICAX  program  by  first  opening  a  file 
for  data  storage.  When  the  write  data  command  is  given,  all 
information  including  data  as  well  as  user  programable  variables 
is  written  into  the  file.  The  data  can  then  be  transfered  to 
floppy  disks  for  future  analysis.  There  are,  of  course,  analagous 
routines  for  reading  data  from  a  file  into  the  computer  memory. 

The  data  can  be  analyzed  any  time  that  it  is  in  the 
memory  of  the  computer,  whether  it  was  Just  taken  from  the 
experiment  or  read  from  a  disk  file.  In  this  manner  the 
experimental  data  can  be  taken  and  quickly  stored,  then  analyzed 
at  a  later  time.  At  present  the  peak  microwave  power  as  well  as 
the  efficiency  can  be  derived  from  the  data. 

Another  convenient  feature  of  the  PICAX  program  is  the 
ability  to  immediately  plot  the  experimental  data.  The  first  type 
of  plot  is  simply  the  voltage  versus  time  plot  of  one  of  the 
transient  digitizers  for  either  a  single  pulse  or  an  average  over 
a  number  of  pulses.  A  second  type  of  plot  that  is  desirable  is  a 
graph  of  one  parameter  as  a  function  of  a  second,  for  example, 
peak  microwave  power  as  a  function  of  average  magnetic  field.  The 
data  presented  in  this  type  of  plot  will  typically  be  averaged 
over  many  pulses. 

Finally,  it  would  be  desirable  to  control  various 
experimental  parameters  through  the  PICAX  program.  Only  a  small 
part  of  the  software  has  been  completed  and  some  of  the  necessary 
hardware  has  been  acquired.  The  Data  Translation  DT2fl0l  has  two 
channels  of  digital  to  analog  converters  as  well  as  sixteen 
channels  of  digital  input  or  output.  One  channel  of  the  digital 
output  has  been  programmed  to  respond  to  the  trigger  on/off 
command.  Also  available  is  a  Transiac  3016  sixteen  channel 
digital  to  analog  conveter  that  resides  in  the  CAMAC  crate.  Two 
of  these  channels  have  been  programmed  to  set  the  superconducting 
magnet  coil  currents  to  the  values  specified  by  the  user 
programmable  variables.  With  this  hardware  combined  with  varying 
amounts  of  interface,  it  should  be  possible  to  control  many  more 
of  the  experimental  parameters  such  as  the  electron  gun  magnetic 
field  and  the  cathode  voltage. 
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The  user  subroutines  are  collected  into  the  files 
USERR.QO,  TJSER1.QO,  USER2.QO,  USER  3 .0.0  ,  USERU.QO,  and  USER  5 . 00  . 
Each  subroutine  is  well  commented  and  the  user  is  refered  to  the 
individual  routine  for  more  detailed  information  than  is  presented 
here.  USERR.QO  contains  the  plotting  subroutines,  and  USER1.Q0 
holds  the  initializing  subroutine  as  well  as  the  data  analysis, 
disk  file  input  and  output  routines  and  the  data  array  zeroing 
routine.  USER2.Q0  has  the  user  command  subroutines  in  addition  to 
the  user  variable  listing  routine,  while  USER3.00  contains  the 
online  help  package  for  the  user  written  subroutines.  USERU.QO 
holds  both  the  routines  to  control  the  experiment  as  well  as  the 
routines  to  convert  the  raw  data  collected  by  the  computer  into 
real  world  units,  and  USER5.Q0  has  all  of  the  routines  necessary 
for  the  actual  data  acquisition. 

Immediately  upon  starting  the  PICAX  program  many 
variables  need  to  be  initialized.  This  is  accomplished  for  the 
user  written  subroutines  in  the  subroutine  UINIT.  Here  such 
parameters  as  the  memory  address  of  the  CAMAC  crate  controller  are 
set.  This  subroutine  is  called  only  once,  so  that  only  parameters 
that  will  not  change  are  set  here. 

To  start  the  experiment  and  take  data,  the  "S"  command  is 
used.  This  calls  the  subroutine  USTART  which  sets  up  the  computer 
to  collect  the  data.  The  type  of  data  to  be  acquired,  number  of 
shots  to  average  over,  etc.  are  all  determined  by  the  previously 
set  USER  VARIABLES.  Data  is  then  actually  collected  in  subroutine 
UPDATE,  which  is  called  automatically.  The  raw  data  is  first 
summed  and  then  averaged  here  before  being  converted  into  real 
world  units.  After  each  data  pulse,  control  is  returned  to  PICAX 
to  check  for  any  keyboard  Input.  If  any  input  exists,  the 
experiment  is  suspended  and  the  input  interpreted.  The  experiment 
may  be  resumed  by  using  the  PICAX  command  "PR"  which  calls  the 
subroutine  UPROCD.  New  attenuator  values  will  be  read  before 
restarting  the  experiment,  so  care  must  be  used  when  interpreting 
the  results  of  such  restarted  experiments.  Upon  completion  of  the 
experiment  and  conversion  of  the  data,  program  control  is  returned 
to  PICAX. 

The  subroutines  UPLOT,  UREAD  ,  and  UWRITE  are  simply 
called  by  PICAX  in  response  to  the  "P",  "R",  or  "W"  commands  to 
either  plot,  read  from  a  disk  file  or  write  the  data  to  a  disk 
file,  respectively.  The  subroutine  UANLYZ  is  called  in  when  the 
"AN"  command  is  executed  and  is  designed  to  provide  data  analysis. 
UVLIST  is  the  subroutine  called  by  the  command  "LV"  and  will  list 
the  USER  VARIABLES.  ^hese  commands  all  execute  a  single  function 
and  then  return  complete  control  to  PICAX. 
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BUILDING  PICAX 


To  build  the  PICAX  program,  the  following  steps  should  be 

taken : 

1)  Collect  all  of  the  necessary  source  files  onto  the 
directory  to  be  used.  A  list  of  the  needed  files  can 
be  found  in  the  link  file  PICAX  (see  below). 

2)  Compile  each  of  the  source  files.  The  FORTRAN  files 
can  be  compiled  by  using  the  batch  file  FORT.BAT  which 
calls  the  appropriate  Microsoft  Fortran  compiler 
programs  (see  the  listing  below).  To  execute 
type: 

FORT  ( filename ) 

The  ASSEMBLY  language  routines  must  be  compiled  by  the 
Microsoft  Assembler  MASM.  At  the  completion  of  this 
step  the  source  files  are  no  longer  needed,  but  the 
object  files  must  all  reside  on  the  directory  being 
used. 

3)  Link  the  object  files  together  to  produce  the 
executable  file  PICAX.EXE.  This  requires  the  presence 
of  the  necessary  libraries  (again  see  the  link  file 
PICAX).  The  Microsoft  link  command  is: 

LINK  apICAX 

where  PICAX  is  the  input  file  to  the  linker. 

L)  Retain  the  file  PICAX.EXE.  All  other  files  may  be 
deleted.  The  program  is  started  by  typing  PICAX  (and 
then  a  return ) . 


PIC  AX 

BATCH  PILES 


PAGE  a 


BATCH  FILES 


POPT . 3 AT 

fori  %  1; 
pas2 

PICAX 

picaxr+ittinr+user5  +  camv3  +  dtinpl  +  vaitl+inp+out  + 
picaxl+picax2+picax3+userr+userl+user2+user3+ 
userU  , picax  ,  ,dos2for+fortran+graf  sub+grafms2 

The  filenames  before  the  first  comma  (on  the  third  line)  are  the 
necessary  object  files  and  the  filenames  after  the  third  comma  are 
the  needed  library  files  (for  example:  D0S2F0R . LIB ) . 


C>pi cax 

PICAX  VERSION  2.00  12  September  1985 

*hel  p 

ERROR  8  -  COMMANDS  ARE  ONE  OR  TWO  LETTERS  FOLLOWED  BY 
DP  TO  4  FLOATING  POINT  NUMBERS  (SEPARATED  3Y  COMMAS). 


FOR 

A  LIST  OF  VALID  COMMANDS  TYPE  LC. 

*1  c 

1. 

a  - 

Add  to  a  user  variable 

2. 

an 

-  Analyze  data 

3. 

cl 

-  Close  the  disk  output  file 

4. 

di 

-  Oi rectory  1 i sting 

5. 

do 

-  Do  1  oop 

6. 

e  - 

Erase  screen 

7. 

ex 

-  Exit  program 

8. 

fi 

-  Find  an  old  disk  file  for  input 

9. 

go 

-  Go  to  program  line 

10. 

he 

-  Help  the  user  out 

11. 

he 

-  Make  hardcopy 

12. 

k  - 

Kill  program 

13. 

1  c 

-  List  commnds 

14. 

)p 

-  List  program 

15. 

1  V 

-  Li  st  vari  abl  es 

16. 

0  - 

Open  a  new  disk  file  for  output 

17. 

pi 

-  Plot  data 

18. 

pa 

-  Pause 

19. 

P  r 

-  Proceed  with  experiment 

20. 

r  - 

Read  a  record  from  disk 

21. 

s  - 

Start  experiment 

22. 

t  - 

Enter  titl  e 

23. 

V  - 

Set  a  user  variable 

24. 

w  - 

Write  a  record  to  disk 

25. 

wa 

-  Wait  in  units  of  10  msec 

26. 

z  - 

Zero  or  initialize  data 

27. 

tr 

-  Trigger  on/off 

*1  V 

Titl  e: 

Experiment  date  and  time  :  0/0/  0  ,  0:  0:  0 

List  of  experimental  parameters. 


VAR( 

1) 

= 

.00000 

Initial  cavity  magnetic  field  (kG) 

VAR( 

2) 

3 

.00000 

Final  cavity  magnetic  field  (kG). 

VAR( 

3) 

= 

0 

Number  of  steps. 

VAR  ( 

4) 

3 

.00000 

Initial  cavity  field  taper  (^). 

'/AR( 

5) 

3 

.00000 

Final  cavity  field  taper  (%). 

VAR( 

6) 

3 

0 

Number  of  steps. 

VAR( 

7) 

3 

.00000 

Initial  e-beam  voltage  (k V ) . 

VAR  { 

8) 

3 

.00000 

Final  e-beam  voltage  (kV). 

VAR( 

9) 

3 

0 

Number  of  steps. 

VAR( 

10) 

3 

.00000 

Initial  e-beam  current  (A). 

VAR  ( 

ID 

3 

.00000 

Final  e-beam  current  (A). 

VAR( 

12) 

3 

0 

Number  of  steps. 

VAR  ( 

13) 

3 

.00000 

Initial  e-beam  alpha. 

VAR( 

1A) 

3 

.00000 

Fi nal  e-beam  al pha. 

VAR( 

15) 

3 

0 

Number  of  steps. 

VAR( 

16) 

3 

0 

Number  of  i ntef erometer  points. 

VAR( 

17) 

3 

0 

Number  of  shots/pt.  to  avg.  over. 

7AR( 

18) 

3 

0 

Number  of  ots.  for  tran.  rec.  1. 

VAR (  19)  = 
VAR(  20)  = 
VAR (  21)  = 
VAR (  22)  = 


Number  of  pts.  for  tran.  re c.  2. 
Number  of  pts.  for  tran.  rec.  3. 
Number  of  pts.  for  tran.  rec.  4. 
Number  of  pts.  for  tran.  rec.  5. 


*fi? 

FIND  AN  OLD  DISK  INPUT  FILE. 

EX:  "FI  N  M" 

WILL  CAUSE  PROGRAM  TO  ASK  FOR  "FILENAME". 

REPLY  WITH  ANY  LEGAL  NAME,  SUCH  AS  "datal.dat". 
THE  FILE  WILL  8E  OPENED  TO  LOGICAL  UNIT  NUMBER  N, 


WITH  RECORD  LENGTH  M.  THE  DEFAULT  VAL 
( IF  SET  TO  0)  ARE  LUN  3  AND  RECORO  LEN 
*fi 

Enter  f il  ename:  si 
Fil  e  si  is  open 

*r 

Record  number  1  is  11700  bytes  Ion 
*1  v 

Title:  User  variable  setup  file. 
Experiment  date  and  time  :  9/27/1985 

List  of  experimental  parameters. 


THE  DEFAULT  VALUES  FOR  N  AND  M 
3  AND  RECORD  LENGTH  11700  BYTES. 


11700  bytes  1  ong. 


10:  8:55 


VAR(  1)  =  45.00000  Initial 

VAR(  2)  =  45.00000  Final  c 

VAR(  3)  =  1  Number 

VAR(  4)  ■  .00000  Initial 

VAR(  5)  =  .00000  Final  c 

VAR(  6)  =  1  Number 

VAR(  7)  =  .00000  Initial 

VAR(  8)  *  .00000  Final  € 

VAR (  9)  »  0  Number 

VAR(  10)  =  .00000  Initial 

VAR (  11)  =  .00000  Final  e 

VAR(  12)  =  0  Number 

VAR (  13)  =  .00000  Initial 

VAR(  14)  *  .00000  Final  e 

VAR(  15)  *  0  Number 

V AR(  16)  =  0  Number 

VAR (  17)  »  5  Number 

VAR(  18)  =  450  Number 

VAR(  19)  «  0  Number 

VAR(  20)  =  0  Number 

VAR (  21)  =  0  Number 

VAR(  22)  =  0  Number 

*T 

TITLE:  example 
*  a  2  2 

*  v  17  4 

*1  v 

Title:  example 

Experiment  date  and  time  :  9/27/1985 

List  of  experimental  parameters. 


Initial  cavity  magnetic  field  (kG ) 
Final  cavity  magnetic  field  (kG). 
Number  of  steps. 

Initial  cavity  field  taper  (%). 
Final  cavity  field  taper  (%). 
Number  of  steps. 

Initial  e-beam  voltage  (kV). 

Final  e-beam  voltage  (kV). 

Number  of  steps. 

Initial  e-beam  current  (A). 

Final  e-beam  current  (A).  . 

Number  of  steps. 

Initial  e-beam  alpha. 

Final  e-beam  alpha. 

Number  of  steps. 

Number  of  i nterf erometer  points. 
Number  of  shots/pt.  to  avg.  over. 
Number  of  pts.  for  tran.  rec.  1. 

Number  of  pts.  for  tran.  rec.  2. 

Number  of  pts.  for  tran.  rec.  3. 

Number  of  pts.  for  tran.  rec.  4. 

Number  of  pts.  for  tran.  rec.  5. 


VAR  ( 

1)  3 

45.00000 

Initial  cavity  magnetic  field  (kG) 

V  ARC 

2)  = 

47.00000 

Final  cavity  magnetic  field  (kG). 

VAR  f 

3)  = 

1 

Number  of  steps. 

VAR  ( 

4)  * 

.00000 

Initial  cavity  field  taoer  (*,). 

VAR  ( 

5)  * 

.00000 

Final  cavity  field  taoer  (?.). 

VAR  f 

6) 

= 

1 

Number 

of  steps. 

VAR  ( 

7) 

s 

.onoon 

Initial 

e-beam  voltage  (kVl. 

VAR  { 

3) 

= 

.00000 

Final  e-beam  voltage  (kVl. 

VAR  ( 

9) 

= 

0 

Number 

of  steps. 

VAR  ( 

10) 

s 

.00000 

Ini  t  i  al 

e-beam  current  i'Al. 

VAR  ( 

11) 

= 

.00000 

Final  e-beam  current  (A). 

VAR  ( 

12) 

= 

0 

Number 

of  steps. 

VA  R( 

13) 

3 

.00000 

Initial 

e-beam  al  pha. 

VAR  ( 

14) 

3 

.00000 

Final  e-beam  alpha. 

VAR  ( 

15) 

3 

0 

Number 

of  steps. 

VAR  ( 

16) 

= 

0 

Number 

of  interferometer  points 

VAR  ( 

17) 

= 

4 

Number 

of  shots/pt.  to  avg.  ove 

VAR  ( 

18) 

= 

450 

Number 

of  pts.  for  tran.  rec.  1 

VAR  ( 

19) 

= 

0 

Number 

of  pts.  for  tran.  rec.  2 

VAR( 

20) 

3 

0 

Number 

of  pts.  for  tran.  rec.  3 

VAR  ( 

21) 

= 

0 

Number 

of  pts.  for  tran.  rec.  4 

VAR (  22)  = 

*1  V? 

LIST  VARIABLES 

0 

Number 

of  pts.  for  tran.  rec.  5 

LIST 

THE 

USER 

VARIABLES,  THEIR 

VALUES, 

AND  A  BRIEF  DESCRIPTION. 

EX:  “LV  N" 

WILL  LIST  THE  FOLLOWING: 

N  VARIARLES 

0  EXPERIMENTAL  PARAMETERS 

1  A-D  CHANNEL  NUMBERS 

2  TRANS  IAC  O-A  CHANNEL  NUMBERS 

3  CAMAC  SLOT  NUMBERS 

4  TRANSIENT  RECORDER  ATTENUATOR  NUMBERS 

5  PLOT  VARIABLES 

6  TRANSIENT  RECORDER  NUMBERS 

7  DATA  TRANSLATION  CALIBRATION  FACTORS 

8  TRANSIENT  RECORDER  CALIBRATION  FACTORS 

10  TRANSIENT  RECORDER  ATTENUATOR  VALUES 

11  DATA  TRANSLATION  OATA 

12  TRANSIENT  RECORDER  OATA 
*  10  s 

*  20  e 

*  30  pi 

*  40  pa 

*  50  he 

*  60  w 

*  55  e 

*1  p 


10 

s 

.0000E+00 

.OOOOE+OO 

.OOOOE+OO 

.OOOOE+OO 

20 

e 

.0000E+00 

.OOOOE+OO 

.OOOOE+OO 

.OOOOE+OO 

30 

pl 

.OOOOE+OO 

.OOOOE+OO 

.OOOOE+OO 

.OOOOE+OO 

40 

pa 

.0000E+00 

.OOOOE+OO 

.OOOOE+OO 

.OOOOE+OO 

50 

he 

.OOOOE+OO 

.OOOOE+OO 

.OOOOE+OO 

.OOOOE+OO 

55 

e 

.OOOOE+OO 

.OOOOE+OO 

.OOOOE+OO 

.OOOOE+OO 

60 

0 

Enter 

w  .OOOOE+OO 

filename:  junk.dat 

.OOOOE+OO 

.OOOOE+OO 

.OOOOE+OO 

Fil  e  al  ready  sxi sts 
*  0 

Enter  filename:  junkl.dat 
File  junkl.dat  is  open 


Record  number  1  is  4334  bytes  long 

★ 

The  microwave  diode  is  unavailable  from  the  transient  recorder. 
Enter  the  pulse  width  (sec)  :  le-6 
Enter  rep  rate  (Hz)  :  100 

Diode  pulse  height  =  .000E+00  volts 

Pulse  width  =  1.000E-06  seconds 
Rep  rate  =  1.000E+02  Hz 
Cathode  voltage  =  -1.782E+00  k V 
Collector  current  =  -2.115E+00  Amps 

Peak  power  =  -1.864E+01  kW 
Efficienty  =  -4.944E+02  * 

*  k 

*  1  p 

*AC  ERROR  1  -  OOPS.  YOU  TYPED  A  CONTROL  C.  TYPE  EX  TO  EXIT. 

*  cl 

*  ex 
C> 


Tab! e  of  Contents 


Ucmnds 


User4  Sc  8  Set . 53 

Tr  8  Set . 55 

V  Set . 55 

Cur  Set . 55 

Gt  Attn . 56 

Real  Dt . 57 

Real  Tr . 57 


User5  Update . 61 

Uprocd . 63 

Ustart . 66 

Dt  Strt . 69 

Gt  Dtrn . 70 

Gt  Tree . 72 


1 


c  This  program  was  modified  to  run  on  an  IBM  PC -XT 

c  by  : 

c  Tom  Hargreaves 

c  JAYCOR 

c  205  S.  Whiting  St. 

c  Alexandria,  VA  2230k 

c 

c  The  original  program  is  in  capital  letters, while 

c  all  modifications  are  in  snail  letters, 

c 

c  Last  modification  :  September  26,  19fl5 

c 

c - — - 

c 

COMMON  /P  FLAGS/  PROG  ON,  EXPT  ON,  QUERY 
LOGICAL  PROG  ON,  EXPT  ON,  QUERY 
COMMON  /?  INTER/  LINE,  ICMND 


63 


COMMON  /?  MATCH/  MCMND,  NMATCH,  CHARS,  nnnchar 
common  /p  c  var  /  n  c  var,  cvar  (L) 
logical  input,  interp 
character  chars*2,  icmnd*2 

Initialize  graphics  and  clear  the  screen. 

CALL  qsmode  (  6  ) 
call  qcolor  (ll,0) 

Initialize  PICAX. 

CALL  INTT 

WRITE  (*,20) 

format( IX , '  * '  $ ) 

IF  (  INPUT(NUM  CHR)  )  GO  TO  50 

IF  ( EXPT  ON)  then 

CALL  UPDATE 

go  to  30 

endif 

IF  (.NOT.  PROG  ON)  GO  TO  30 
CALL  XECUTE( NMATCH) 

CALL  NXT  LN 

IF  (PROG  ON)  GO  TO  30 

GO  TO  10 

EXPT  ON  *  .FALSE. 

PROG  ON  =  .FALSE. 

IF  (NUM  CHR  .EQ.  0)  GO  TO  10 
IF  (NUM  CHR  .NE.  -l)  GO  TO  60 
CALL  ERROR(l) 

GO  TO  10 

IF  ( INTERP  ( ) )  GO  TO  TO 
CALL  ERROR(3) 

GO  TO  10 

IF  (LINE.EQ.O  .OR.  ICMND.NE.char(O) )  GO  TO  80 

CALL  DELETE 

GO  TO  10 

NMATCH  =  0 

mcmnd  =  0 

CALL  SEARCH 

IF  (NMATCH  .EQ.  0)  GO  TO  90 
NUM  ERR  *  0 

IF  (LINE  .EQ.  0)  CALL  XECUTE( NMATCH ) 

IF  (LINE  .BE.  0)  CALL  INSERT 
GO  TO  10 

NUM  ERR  *  NUM  ERR  +  1 
IF  (NUM  ERR  .EQ.  3)  GO  TO  100 
CALL  ERR0R(2) 

GO  TO  10 
NUM  ERR  3  0 
CALL  XECUTE  (13) 

GO  TO  10 
END 


V- 


•  ■  .  *  .  *  »  *>  /  "  ►>  *  > 
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SUBROUTINE  XECUTE  (N) 


C 

C- 


EXECUTES  SYSTEM  COMMANDS 


C 

C 

r 

C 

C 

C- 


THIS  ROUTINE  IS  PART  OF  THE  PICAX  PROGRAM 
WRITTEN  BY  ROBERT  WALRAVEN,  IICD  -  DAVIS 
LAST  MODIFICATION  ON  19  SEP  fll 


r 


C 


10 


c 

c— . 

100 


130 


COMMON  /P  C  VAR  /  NCVAR,  CVAR(U) 

COMMON  /P  DO  VAR  /  DO  FRST,  DO  LAST,  DO  CNT 
COMMON  /U  VAR  /  N  U  VAR,  U  VAR  (150) 
common/p  files /nopen, lunopn(6) ,lunfnd(6) ,nfound, 
c  irecl(6)  ,irnr(6)  ,imv(6)  ,irnvmx(6) 


COMMON  /P  FLAGS 
COMMON  /P  INTER 
COMMON  /P  MATCH 
COMMON  /PROGRM 
COMMON  /P  VAR 
COMMON  /P  TITLE 
LOGICAL  PROG  ON, 


/  PROG  ON,  EXPT  ON,  QUERY 
/  LINE,  ICMND 

/  MCMND,  NMATCH,  CHARS,  mnchar 
/  NLINES,  N  LN  MAX,  PROG(50) 

/  NCTRLC,  LN  PTR,  P  VERSN 
/  LITTLE  (36) 

EXPT  ON,  QUERY 


logical  lexist 


INTEGER  DO  FRST,  DO  LAST,  DO  CNT 

character  key*l,  ltitle*2,  chars*2,  icnmd*2,  fname*20 


IF  (.NOT. QUERY)  GO  TO  10 
CALL  INFO(N) 

QUERY  =  .FALSE. 

RETURN 

GO  TO  (100,200,300,1*00,500,600,700,800,900,1000,1100,1200,1300 

1  lLOO  ,1500  ,1600  ,1700  ,1800  ,1900  ,2000 ,2100 ,2200  ,2300  ,21*00 ,2500  , 

2  2600  ,2700  ,2800 )  ,N 


- ADD  TO  A  GENERAL  VARIABLE 

I  *  CVAR(l) 

IF  ( I.GE.l  .AND.  I.LE.NUVAR)  GO  TO  130 

CALL  ERROR(M 

RETURN 

UVAR(I)  =  UVAR(I)  +CVAR(2) 

RETURN 


200  CALL  UANLYZ 
RETURN 

C - CLOSE  THE  DISK  OUTPUT  FILE 

300  LUN  *  2 

IF  (CVAR(l)  .NE.  0.)  LUN  =  CVAR(l) 

IF  (NOPEN  .NE.  0)  GO  TO  305 

CALL  ERROR  (l6) 

return 

305  DO  310  1=1, NOPEN 

IF  (LUN  .EQ.  LUNOPN(I))  GO  TO  320 


310  CONTINUE 

CALL  ERROR  (IT) 

RETURN 

320  vrite(  lun,err=360  ,rec=(  iravmx(  i)+l)  )lun 
backspace  lun 
endfile  Inn 

CLOSE( LUN , iostat= ioerr ) 
if( ioerr)  340,330,350 

330  IF  (I  .EQ.  NOPEN)  L'JNOPN  (NOPEN)  =  0 
LUNOPN(I)  =  LUNOPN( NOPEN) 

NOPEN  =  NOPEN  -  1 
return 

340  write(#,'(''  End  of  file  on  close  operation. ")' ) 

return 

350  write( Error  on  close  operation. '') 1 ) 
return 

360  write( Error  on  write.' ')') 

RETURN 

C - DIRECTORY  LISTING 

400  I  =  CVAR(l) 

IP  (I.NE.6)  1*5 
CALL  qsmode  (  6  ) 
call  qcolor  (11,0) 
write  (#,4l0) 

4 10  format ('  Directory  listing  not  implemented') 

RETURN 

500  I  *  CVAR(l) 

DO  LAST  =  LINE  NM  (i) 

IP  (DO  LAST  .NE.  0)  GO  TO  520 
CALL  SRROR( 5 ) 

RETURN 

520  DO  CNT  *  CVAR(  2) 

DO  FRST  *  LN  PTR 
RETURN 

C — — - - - - ERASE  SCREEN 

600  CALL  qsmode  (  6  ) 
call  qcolor  (ll,0) 

RETURN 


TOO  IF  (NOPEN  .EQ.  0)  GOTO  T20 
DO  T10 ,  1*1, NOPEN 

vrite(lunopn(  i)  ,err=T15  ,rec*(  imvmx(  i)+l) )  lun 
backspace  lunopn(i) 
endfile  lunopn ( i ) 

CLOSE ( LUNOPN ( I ) , iostat*ioerr ) 

T10  if(ioerr  .ne.  0)write(*, ' ( ' '  Error  closing  logical  unit  ’’i 
c  lunopn(i) 

go  to  T20 

T15  write(*,'(''  Error  writing  to  logical  unit  " i3) ' )lunopn( i) 

T20  continue 

call  qsmode  ( 3 ) 
call  qclear  (0,T) 
continue 


CALL  EXIT 


■PINT)  OLD  DISK  INPUT  PILE 


300 


310 

820 

325 

830 


8Uo 

350 

860 

870 

Q  a 

900 


lun  =  3 
ioerr  =  0 

if  (cvar(l)  ,ne.  0.0)  lun  =  cvar(l) 

if  (nfound  .  eq.  0)  go  to  330 

do  810  i=l , nfound 

if  (lun  .eq.  lunfnd(i))  go  to  320 

continue 

go  to  830 

close  (lun,iostat=ioerr) 

if (ioerr)  860,825,870 

if  (i  .eq.  nfound)  lunfnd( nfound)  =  0 

lunfnd(i)  *  lunfnd( nfound) 

nfound  =  nfound  -  1 

if  (nfound  .eq.  6)  go  to  8L0 

write  (*,'("  Enter  filename:  ",$)') 

read  ( * , ' ( a20 ) ' )  fname 

inquire  (file»fname,  exist=lexist) 

if  (.not.  lexist)  then 

call  error  ( 15 ) 

return 

endif 

irecl( nfound+l)  *  11700 

if(cvar(2)  .ne.  0.0) irecl( nfound+l)  *  cvar(2) 
open ( lun, file*fname, statu s=* old* ,access=' direct ' ,iostat=ioerr 
*  recl=irecl( nfound+l)) 

if  (ioerr  .eq.  0)  then 

read ( lun, iostat=ioerr, err*850 ,rec*l)irecln 
rewind  lun 

if(irecln  .ne.  irecl ( nfound+l ) )  then 

write(*,'("  Incorrect  record  length,  the  correct  length  is  ' 
c  i6) ' )  irecln 

close  (lun) 
return 
endif 

nfound  *  nfound  +  1 
lunfnd( nfound)  *  lun 
irar  (nfound)  =  i 

write  (*,'("  File  ",a20,"  is  open")')  fname 
return 
endif 

call  error  (6) 

if  (ioerr  .It.  0)  write  (*,'("  End  of  file")') 
return 

write(*,'("  Error  on  test  read.")') 
return 

write(*,,("  End  of  file  on  close  operation.")') 
return 

write(*,'("  Err^r  on  close  operation.")') 

RETURN 

- GO 

I  =  CVAR(l) 

IF  (I  .EQ.  0)  GO  TO  910 


LN  PTR  =  LINE  NM(I) 

IF  (LN  PTR  .NE.  0)  GO  TO  920 
CALL  SRFCP.(T) 

RETURN 

LN  PTR  =  1 

PROG  ON  =  .TRUE. 

RETURN 


CALL  ERRORS) 
RETURN 

CALL  psora 
RETURN 


- HARD  COPY 


-KILL  PROGRAM 


NLINES  =  0 
PROG  ON  * 
RETURN 


.FALSE. 


MCMND  a  -1 
CALL  SEARCH 
MCMND  =  0 
RETURN 

CALL  PLIST 
RETURN 


-LIST  COMMANDS 


-LIST  PROGRAM 


- LIST  VARIABLES 

CALL  UVLIST 
RETURN 

- OPEN  NEW  DISK  OUTPUT  FILE 

if  (nopen  .eq.  6)  go  to  l6L0 
ioerr  =  0 
Inn  *  2 

if  (cvar(l)  ,ne.  0.0)  Lin  a  cvar(l) 
write  (*,’("  Enter  filename:  ”,$)') 
read  (*,’(a20)')  fname 
inquire  (file  =  fname,  exist  =  lexist) 
if  (lexist)  then 

write  (*,*("  File  already  exists'’)') 

return 

end  if 

if  (nopen  .eq.  0)  go  to  1630 

do  l6l0  i=l, nopen 

if  (lun  .eq.  lunopn(i))  go  to  1620 

continue 

go  to  1630 

close  ( lun.iostataioerr) 

if (ioerr)  1650 ,1625 ,1660 

if  (i  ,eq.  nopen)  lunopn( nopen)  =  0 

lunopn ( i )  a  innopn ( nopen ) 

nopen  =  nopen  -  1 

irecl  (nopen+l)  =  11700 

if(cvar(2)  .ne.  0.0) irecl (nopen+l)  a  cvar(2) 

open ( lun, file=fname, statu s*1 new' ,access=' direct ' ,iostat=ioerr 
*  recl=irecl( nopen+l ) ) 


if  (ioerr  .ne.  0)  then 
call  error  (9) 

if  (ioerr  .It.  0)write(  * , '  (  "  End  of  file”)') 

return 

endif 

write  (lun,  err=l6L0 ,  rec=l )  lun 

rewind  ( lun ) 

nopen  =  nopen  +  1 

lunopn  (nopen)  *  lun 

irnw  (nopen)  -  1 

imvmx  (nopen)  =  0 

write(*,,(''  Pile  ,,,a20,''  is  open*')')  fname 
return 

l6  Uo  call  error  ( 9-) 
return 

1650  vrite( *,'(''  End  of  file  on  close  operation. *  * ) ' ) 
return 

1660  write(#,'(''  Error  on  close  operation. *’)' ) 


RETURN 

C - PLOT  DATA 

1700  CALL  UPLOT 
RETURN 

1800  call  inkey  (  key  ) 
num  =»  ichar(key) 

IF  (  num  .NE.  13  )  GO  TO  1800 
RETURN 

C - - - - PROCEED 

1900  EXPT  ON  *  .TRUE. 

CALL  UPROCD 
RETURN 

C - READ 

2000  LUN  =  3 


IF  (CVAR(l)  .NE.  0.0)  LUN  =*  CVAR(l) 
IF  ( NF0UND  .EQ.  0)  GO  TO  2020 
DO  2010,  1-1 ,NF0UND 
IF  (LUN  .EQ.  LUNFND(l) )  GO  TO  2030 
2010  CONTINUE 
2020  CALL  ERR0R(15) 

RETURN 

2030  CALL  UREAD(LUN,i) 

RETURN 


C - START 

2100  EXPT  ON  =  .TRUE. 

CALL  USTART 
RETURN 

C - - - - - TITLE 

2200  CALL  TITLE 
RETURN 


2300  I  »  CVAR(l) 

IF  (I.GE.1  .AND.  I.LE.NUVAR)  GO  TO  2310 
CALL  ERROR(L) 

RETURN 

2310  UVAR(I)  -  C?AR(2) 

RETURN 


C 


WRITE 


o  a  o  o  o  o  o 


yr  ar( i) 


I ?  (CVAR(l)  .US.  0.0)  LUN  = 

IF  (  N  0  ?  EN  .  EQ .  0)  GO  TO  2’*20 
DO  21*  10,  1  =  1  ,NOPEN 

I?  f  LUN  .  EQ.  LUNOPN(l^)  GO  TO  2^30 

CONTINUE 

CALL  SRH0R(13) 

RETURN 

CALL  UWRITE ( LUN , i ) 

RETURN 

I  *  CVAR(l) 

CALL  WAIT  (I) 

RETURN 


2600 

CALL  UZERO 

RETURN 

2T00 

CALL  UCMNDS  (N) 

RETURN 

- USER  COMMANDS 

C 

2800 

RETURN 

C 

END 

SUBROUTINE  NXT  LN 

GETS  NEXT  LINE  OF  PROGRAM 

THIS  ROUTINE  IS  PART  OF  THE  PICAX  PROGRAM 
WRITTEN  BY  ROBERT  WALRAVEN,  IICD  -  DAVIS 
LAST  MODIFICATION  ON  29  JUN  8l 


COMMON 

/?  C  VAR 

/ 

NCVAR  , 

CVAR(U) 

COMMON 

/P  DO  VAR 

/ 

DO  FRST, 

DO  LAST, 

DO  CNT 

COMMON 

/?  FLAGS 

/ 

PROG  ON, 

EXPT  ON, 

QUERY 

COMMON 

/P  MATCH 

/ 

MCMND  , 

NMATCH,  CHARS,  amchar 

COMMON 

/ PROGRM 

/ 

NLINES 

,  N 

LN  MAX, 

PROG ( 50  ) 

COMMON 

/P  VAR 

/ 

NCTRLC 

,  LN  PTR,  P 

VERSN 

LOGICAL 

PROG  ON, 

EXPT  ON, 

QUERY 

INTEGER 

DO  FRST , 

DO  LAST, 

DO 

CNT 

character  chars* 
DIMENSION  N( 2 ) 

2 

EQUIVALENCE  (PACK, 

N(  1)  ) 

IF  (.NOT.  PROG  ON) 

RETURN 

I?  (  DO 

CNT  .EQ. 

0) 

GO  TO 

10 

IF  (LN 

PTR  .LE. 

DO 

LAST) 

GO 

TO  10 

DO  CNT 

=  DO  CNT 

- 

1 

IF  (DO 

CNT  .NE. 

0) 

LN  PTR 

= 

DO  FRST 

IF  (LN 

PTR  .LT. 

NLINSS+l) 

GO 

TO  20 

PROG  ON  =  .FALSE. 

RETURN 

20  INDEX  =  LNPTR*5  - 

PACK  =  PROG  (INDEX) 

N MATCH  =  N( 2 ) 

DO  30  1  =  1,  h 

30  CVAR(I)  =  PROG  (INDEX  +  l) 
LN  PTR  =  LN  PTR  +  1 
RETURN 
END 

LOGICAL  FUNCTION  INPUT(N) 

C 


C 

C  INPUTS  A  STRING  OF  TEXT  OF  UP  TO  72  CHARACTERS  FROM  CONSOLE. 

C 

C  WHILE  TEXT  IS  BEING  TYPED,  THE  SYSTEM  CONSOLE  HANDLER  HOLDS 

C  THE  INPUT.  WHEN  A  RETURN  OR  CONTROL-C  IS  TYPED,  THE  TEXT  IS 

C  THEN  AVAILABLE  TO  THE  USER.  THIS  ROUTINE  GETS  A  CHARACTER 

C  AT  A  TIME  FROM  THE  HANDLER  BY  CALLING  THE  SYSTEM  ROUmINE 

C  ITTINR.  ON  RETURN,  IF  TEXT  IS  AVAILABLE,  IT  IS  PUT  IN  THE 

C  VARIABLE  'STRING'  AND  ' NCHAR *  IS  THE  NUMBER  OF  CHARACTERS 

C  TYPED  (NOT  COUNTING  RETURN).  IF  A  CONTROL-C  WAS  TYPED,  NCHAR 

C  WILL  HAVE  A  VALUE  OF  -1. 

C 

C  INPUT  =  .FALSE.  IF  NO  TEXT  IS  AVAILABLE 

C  =  .TRUE.  IF  TEXT  RETURNED 

C 

C  THIS  ROUTINE  IS  PART  OF  THE  PICAX  PROGRAM 


WRITTEN  BY  ROBERT  WALRAVEN ,  UCD  -  APPLIED  SCIENCE 
LAST  MODIFICATION  ON  U  AUG  80 


GO  TO  10 

NCHAR  *  NCHAR  -  1 
write  (*,’(/$)’) 

GO  TO  hO 
NCHAR  *  -1 
N  =  NCHAR 

STRING (NCHAS+1)  *  0 

RETURN 

END 

PICAX1  .FOR 


$  storage : 2 


PICAX  OVERLAY  MODULE  -  REGION  1 


LOGICAL  FUNCTION  INTERPO 


INTERPRETS  A  LINE  TYPED  BY  THE  USER.  THE  FORM  OF  THE  LIN 
MUST  BE 

(LINE  NUMBER]  COMMAND  [ NUMBER ( , NUMBER ( , NUMBER ( , NUMBER  1  ]  ]  ] 
IF  A  VALID  LINE  IS  TYPED,  ON  RETURN  INTERP  IS  TRUE, 
OTHERWISE  IT  IS  FALSE. 

THIS  ROUTINE  IS  PART  OF  THE  PICAX  PROGRAM 
WRITTEN  BY  ROBERT  WALRAVEN,  UCD  -  APPLIED  SCIENCE 
LAST  MODIFICATION  ON  5  DEC  Si 


This  routine  was  modified  to  run  on  an  IBM  PC-XT 
by  : 

Tom  Hargreaves 
JAYCOR 

205  S.  Whiting  St. 

Alexandria,  VA  2230U 

Last  modification  on  5  Oct  %h 


COMMON  /P  FLAGS  /  PROG  ON,  EXPT  ON,  QUERY 
COMMON  /P  INTER  /  LINE,  ICMND 
COMMON  /P  C  VAR  /  NCVAR ,  CVAR(M 
LOGICAL  PROG  ON,  EXPT  ON,  QUERY 
logical  number,  ncnvrt 
character  IN(2)*1,  i*l,  icmnd*2 
EQUIVALENCE  ( IN ( 1 ), ICMND ) 


LOOK  FOR  LINS  NUMBER 

LINE  =  0 
ICMND  *  char ( 0 ) 

INTSRP  =  .TRUE. 

00  1  11  =  1 , NCV  AR 
CVAR(II)  =  0. 

II  =  NEXT(O) 

I  =  char ( II ) 

IP  (II.LT.O)  RETURN 
IF  ( .NCT.NUMBER( Ii)  )  GO  TO  30 
LINS  =  LINE*10  +  II 
IF  (LINS. LE. 999)  GO  TO  10 
CALL  ERROR(lO) 

RETURN 

GET  COMMAND 

IF  (I  .NE.  '  •)  GO  TO  35 
ii  =  next  (o) 

I  =  char  (ii) 

GO  TO  30 

IN ( 1 )  =  I 
IN( 2 )  =  '  ' 

II  =  NEXT(-l) 

I  =  char(  II  ) 

IF  (II.LT.O)  RETURN 

IF  (i.LT.'a'  .OR.  I.GT.'z’)  GO  TO  UO 
IN ( 2 )  =  I 


SKI?  REST  OF  WORD 

II  =  NEXT(O) 

II  =  NEXT(-l) 

I  =  char(  II  ) 

IF  (i.GE.'a'  .AND.  I.LE.'z')  GO  TO  36 
GET  VARIABLES 

IF  (I  .EQ.  '?')  QUERY  =  .TRUE. 

IF  (QUERY)  RETURN 
IF  (II.LT.O)  RETURN 
DO  50  11=1 ,NCVAR 

IF  ( . NOT . NCNVRT( X ) )  INTERP  =  .FALSE. 

CVAR(II)  =  X 

RETURN 

END 


LOGICAL  FUNCTION  MATCH  ( NCMND ,  nstng,  CSTRNG ) 


IF  MCMND 


IF  MCMND 
IF  MCMND 


=  0,  COMPARES  ICMND  WITH  NSTRNG .  -- 

IF  ICMND  =  NSTRNG,  THEN  NMATCH  =  NCMND  , 

AND  MATCH  =  .TRUE. 

IF  ICMND  <>  NSTRNG,  MATCH  =  .FALSE. 

*  -1,  PRINTS  NCMND ,  MSTRNG ,  AND  CSTRNG  ON  CONSOL: 
=  1,  COMPARES  nmatch  WITH  NCMND 


THIS  ROUTINE  IS  PART  OF  THE  PICAX  PROGRAM 
WRITTEN  3Y  ROBERT  WALRAVEN,  UCD  -  APPLIED  SCIENCE 
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COMMON  / P  MATCH  /  MCMND,  NMATCH,  CHARS,  mmchar 

COMMON  /P  INTER  /  LINE,  ICMND 

character*!  NSTRNG(U),  0UTPUT(72),  MCHAR(U) 

character  CSTRNG*35,  icmnd*2,  mstrng*2,  chars*2,  nstng*U  ,  nsng*k 
EQUIVALENCE  ( MSTRNG ,MCHAR ( 1 ) 5 
equivalence  ( nsng , nstrng( 1 5 } 

EQUIVALENCE  (CHARS  ,MCHAR(l)) 

MATCH  =  .FALSE, 
nsng  ■  nstng 
DO  1  1=1,  k 

MCHAR(I)  =  NSTRNG ( I ) 

IF  (MCMND  .EQ.  0)  GO  TO  10 

IF  (MCMND  .EQ.  l)  GO  TO  20 

IF  (MCMND  .EQ.  -1 )  GO  TO  100 

RETURN 

IF  (ICMND  .NE.  MSTRNG)  RETURN 
NMATCH  *  NCMND 
MATCH  =  .TRUE. 

RETURN 

IF  (nmatch  .EQ.  NCMND)  MATCH  =  .TRUE. 

RETURN 

IF  (NCMND  .EQ.  l)  CALL  qsmode  (  6  ) 
if  ( ncmnd  .eq.  l)  call  qcolor  (11,0) 

WRITE  (*,110)  NCMND,  MSTRNG 
FORMAT ( IX, 12' . '  ,2X  ,A2 '  -  »$) 
write  (*,120)  cstrng 
format  ( lx  ,a35 ) 

RETURN 

END 


GO  TO 
GO  TO 
GO  TO 


MSTRNG)  RETURN 


.  NCMND)  MATCH  =  .TRUE. 

l)  CALL  qsmode  (  6  ) 
l)  call  qcolor  (11,0) 
NCMND ,  MSTRNG 
' , 2X ,A2 '  -  ’$) 
cstrng 


LOGICAL  FUNCTION  NCNVRT(X) 


CONVERTS  A  FREE  FIELD  ASCII  STRING  INTO  A  NUMBER. 

THE  ASCII  STRING  IS  SCANNED  UNTIL  AN  ILLEGAL 
CHARACTER,  A  CARRIAGE  RETURN,  OR  A  COMMA  IS  ENCOUNTERED. 
THE  NUMBER  IS  RETURNED  IN  X .  IF  THE  STRING  IS  AN 
INVALID  NUMBER,  NCNVRT  IS  RETURNED  .FALSE. 


^ .  *’■  »*.  •*.  »*. . ■*.  *. 
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logical  dec  fig,  number 
character*!  I  CHAR r 

NCNVRT  *  .TRUE. 

N COMMA  =  0 
NDEC  =  0 
DECFLG  =  .FALSE. 

SIGN  =  1.0 


NESIGN  =  1 
X  *  0. 

i  *  next  (0) 

ICHARr  =  chart  i  ) 

IF  (i  .LT.  0)  RETURN 


IF 

(iCHARr  .EQ. 

V  1 

) 

GO 

TO 

1 

IF 

(iCHARr  .EQ. 

f+» 

) 

GO 

TO 

10 

IF 

(iCHARr  .NE. 

1  _  I 

) 

GO 

TO 

20 

SIGN  =  -1. 

i  a 

next  (0) 

ICHARr  =  chart  i 

) 

IF 

(i  .LT.  0)  GO 

TO 

1000 

IF 

( . NOT . NUMBER ( 

i 

)) 

GO 

TO 

50 

icharl  =  i 
X  a  x*10.  +  ICHAR1 
IF  (DECFLG)  NDEC  a  NDEC+1 
i  =  next  (0) 

ICHARr  =  char (  i  ) 

IF  (ICHARr. EQ. '  .OR.  ICHARr. EQ .  '  ')  GO  TO  40 

IF  (ICHARr  . EQ .  '= ’ )  GO  TO  UO 

IF  (1  .GE.  0  )  GO  TO  20 

X  =  SIGN*X/( 10 .**NDEC) 

RETURN 

IF  (ICHARr  .NE.  '.’)  GO  TO  60 
IF  (DECFLG)  GO  TO  1000 
DECFLG  »  .TRUE. 

GO  TO  30 

IF  (ICHARr  .EQ.  .or.  icharr  .eq.  ’  '  )  GO  TO  UO 

IF  (iCHARr  .NE.  fer)  GO  TO  1000 
i  =  next  (C) 

ICHARr  =  chart  i  ) 

IF  (i  .LT.  0)  GO  TO  1000 
IF  (iCHARr  . EQ .  ’+’)  GO  TO  70 
IF  (iCHARr  .NE.  ’-’)  GO  TO  80 
NESIGN  =  -1 
i  =  next  (0) 

ICHARr  =  chart  i  ) 

IF  (i  .LT.  0)  GO  TO  1000 

IF  ( . NOT . NUM3ER(  i  ))  GO  TO  1000 


*  ')  GO  TO  90 


i  *  next  (0) 

ICRARr  =  char(  i  ) 

I?  (ICHARr  .SO,.  .or.  icharr  .eq. 

IF  (i  .GE.  0)  GO  TO  100 

90  x  *  sign#x/(io.»*(ndec-nesign*nfx?)) 

RETURN 

100  IF  (,N0T.NUMBER(  i  ))  GO  TO  1000 
icharl  =  i 

NEXP  =  NEXP*ld  +  I CHARI 
i  »  next  (0) 

ICHARr  =  char(  i  ) 

IF  (NEXP  .LE.  20)  GO  TO  90 
1000  NCNVRT  =  .FALSE. 

X  *  0. 

RETURN 
END 
c 

FUNCTION  NEXT(I) 

C 

C - 

n 

C  GETS  THE  NEXT  CHARACTER  FROM  THE  TEXT  BUFFER.  ON  EXIT,  'NEXT 

C  CONTAINS  THE  CHARACTER  AND  THE  TEXT  BUFFER  POINTER  ' NPTR'  IS 

C  UPDATED  BY  1+1  CHARACTERS.  IF  NO  CHARACTER  IS  AVAILABLE, 

C  'NEXT'  IS  SET  EQUAL  TO  -1. 

C 

C  THIS  ROUTINE  IS  PART  OF  THE  PICAX  PROGRAM 

C  WRITTEN  BY  ROBERT  WALRAVEN,  UCD  -  APPLIED  SCIENCE 

C  LAST  MODIFICATION  ON  U  AUG  flO 

C 

C - 

c 

c 

c  Modified  so  that  'NEXT'  contains  the  ascii  code 

c  of  the  character, 

c 

c  Last  modification  on  IT  Oct  84 

c 

c  — . . . . — - - - - - - - 

COMMON  /p  INPUT  /  NCHAR,  STRING (72),  NPTR 
character*l  STRING 

IF  (NPTR  .LE.  NCHAR)  GO  TO  10 

NEXT  a  -1 

RETURN 

10  NEXT  a  ichar(  STRING(NPTR)  ) 

NPTR  »  NPTR+l+I 
RETURN 
END 
c 

LOGICAL  FUNCTION  NUMBER(l) 

C 


TEST  THE  VALUE  OF  I  TO  SEE  IE  IT  IS  A  NUMERIC  CHARACTER. 

ON  RETURN,  IF 

NUMERIC  :  ’  NUMBER '  TRUE  AND  I=fIUMERIC  VALUE  OF  CHAR 
NON- NUMERIC  :  'NUMBER'  FALSE  AND  I  'JNCHANGED 

THIS  ROUTINE  IS  PART  OF  THE  PICAX  PROGRAM 
WRITTEN  3Y  ROBERT  WALRAVEN,  UCD  -  APPLIED  SCIENCE 
LAST  MODIFICATION  ON  U  AUG  SO 


DEFINES  VALID  PICAX  SYSTEM  COMMANDS.  THE  FIRST  ARGUMENT 
OF  MATCH  IS  THE  COMMAND  NUMBER,  THE  SECOND  ARGUMENT  IS  THE 
ONE  OR  TWO  LETTER  COMMAND,  AND  THE  THIRD  ARGUMENT  IS  A 
BRIEF  DESCRIPTION  OF  THE  COMMAND. 

THIS  ROUTINE  IS  PART  OF  THE  PICAX  PROGRAM 
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logical  MATCH 

IF(match(l, 

'a 

' , 'Add  to  a  user  variable 

’))RETURN 

IF( MATCH( 2 , 

'an 

' , 'Analyze  data 

' ) ) RETURN 

IF(MATCH(3, 

'cl 

Close  the  disk  output  file 

' ) )return 

IF(MATCH(U, 

'di 

', 'Directory  listing 

'))RETURN 

IF(MATCH( 5 , 

'do 

','Do  loop 

' ) )return 

if(match(6. 

'e 

', 'Erase  screen 

' ) )return 

IF(MATCH(7, 

'ex 

' , ' Exit  program 

' ) )  return 

if(match(s. 

'fi 

',’Find  an  old  disk  file  for  input 

'))RETURN 

IF(MATCH(9, 

'go 

','Go  to  program  line 

' ) )RETURN 

if(match(io 

,  'he 

','Help  the  user  out 

' ) ) RETURN 

IF(MATCH(ll 

, 'he 

','Make  hardcopy 

' ) ) return 

IF( MATCH( 12 

,'k 

' , 'Kill  program 

' ) )  RETURN 

IF(MATCH( 13 

,'lc 

','List  commands 

' ) ) RETURN 

if(match( lU 

,'lp 

','List  program 

'))RETURN 

IF(MATCH(15 

,'lv 

','List  variables 

’ ) ) return 

IF ( MATCH (16 

,’o 

','Open  a  new  disk  file  for  output 

' ) ) RETURN 

IF (MATCH (17 

,'pl 

' ,'Plot  data 

' ) ) RETURN 

IF(MATCH( 18 

,'pa 

' ,  'Pause 

'))RETURN 

IF( MATCH(  19  , '  pr 

',' Proceed  with  experiment 

' )  )retttrn 

IF(MATCH( 20 ,  'r 

','Read  a  record  from  disk 

'))RETURN 

IF(MATCH( 21 , ' s 

' , ' Start  experiment 

' ) ) RETURN 

IF( MATCH( 22 , 't 

',' Enter  title 

' ) ) RETURN 

IF(MATCH(23,'v 

' , *  Set  a  user  variable 

' ) ) RETURN 

IF(MATCH(2U,'w 

',' Write  a  record  to  disk 

’ ) ) RETURN 

IF (MATCH (25 , 'wa 

' , 'Wait  in  units  of  10  msec 

' ) ) RETURN 

IF( MATCH( 26 , ' z 

','Zero  or  initialize  data 

' ) ) RETURN 

CALL  UMATCH 

RETURN 

END 

FUNCTION  LINE  NM 

(LINE) 

RETURN  THE  LINE  COUNT  FOR  A  LINE  NUMBER  'LINE'.  IE  THE 
LINE  DOES  NOT  EXIST,  LINE  NM  IS  RETURNED  ZERO. 
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COMMON  /PROGRM  /  NLINES,  N  LN  MAX,  PROG (50) 
EQUIVALENCE  (PACK,N) 

LINE  NM  =  0 

IF  (NLINES  .NE.  0)  GO  TO  30 
CALL  ERROR(ll) 

RETURN 

DO  UO  1=1, NLINES 
PACK  *  PROG (1*5-4) 

IF  (N  .EQ.  LINE)  GO  TO  50 

CONTINUE 

GO  TO  10 

LINE  NM  *  I 

RETURN 

END 

subroutine  wait(i) 

This  routine  wa.it s  i  increments  of  approximately 
9.2  milliseconds  before  returning  by  printing  nul 
characters  to  the  screen. 


character  ichar*l 

ichar  =  char  (0) 
do  10  J=l,i 

write  (*, ' (al ,tll,S) ' )  Ichar 
return 


laviij 


o  o  o  o  o  o  o  (y*  o  o  o 


PICAX2 .FOR 


storage: 2 


PICAX  OVERLAY  MODULE  -  REGION  2 


SUBROUTINE  DEFINE  (N,  TYPE,  STRING) 
C 


r* 

c 

c 

c 

c 

c 

c 

c 

c— 


PRINTS  N,  UVAR(N)  AND  DESCRIPTIVE  ASCII  STRING  ON  CONSOLE 

THIS  ROUTINE  IS  PART  OF  THE  PICAX  PROGRAM 
WRITTEN  BY  ROBERT  WALRAVEN,  UCD  -  APPLIED  SCIENCE 
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c  This  program  was  modified  for  use  with  an  IBM-PCXT 

c  by  : 

c  Tom  Hargreaves 

c  JAYCOR 

c  205  S.  Whiting  St. 

c  Alexandria,  VA  2230 U 

c 

c  Last  modified  :  September  2 6 ,  1985 

c 

c - - - - - - — — - — - - — - — - — 

c 

COMMON  /U  VAR  /  N  U  VAR,  U  VAR  (150) 

COMMON  /P  TITLE  /  LTITLE  (36) 
character  TYPE*1,  string*35 ,  ltitle*2 
Integer  n 

C 

IF  (N  .GT.  NUVAR)  RETURN 
VALUE  *  UVAR(N) 

WRITE  (*,10)  N 

10  FORMAT ( '  VAR('I3')  *  ' ,$) 

IF  (TYPE  ,EQ.  'i')  IVALUE  =  VALUE 

IF  (TYPE  .EQ.  'i’)  WRITE  (*,20)  IVALUE 

IF  (TYPE  .EQ.  »r')  WRITE  (*,30)  VALUE 

IF  (TYPE  .EQ.  ’e’)  WRITE  (*,J*0)  VALUE 

20  F0RMAT(I12,5X$) 

30  FORMAT(F12.5,5XS) 

UO  F0RMAT(1PE12.5,5X$) 

write  (*,50)  string 
50  format  (lx,a35) 

RETURN 

END 


SUBROUTINE  DELETE 


DELETE  A  LINE  FROM  THE  PROGRAM 
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COMMON  /P  INTER  /  LINE,  ICMND 

COMMON  /PROGRM  /  NLINES,  N  LN  MAX,  PROG (50) 

character  icmnd*2 

I  »  LINE  NM(LINE) 

IF  (I.EQ.O)  RETURN 

IF  (I  .EQ.  NLINES)  GO  TO  20 

DO  10  J=»I,(MLINES-l) 

N  »  (J-l)*5 
DO  10  JJ*1,5 
NN  =  N+JJ 

PROG  (NN)  =>  PROG  (NN+5) 

NLINES  =  NLINES  -  1 

RETURN 

END 

SUBROUTINE  ERROR  (i) 


PRINT  ERROR  MESSAGES 

THIS  ROUTINE  IS  PART  OF  THE  PICAX  PROGRAM 
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COMMON  /P  FLAGS  /  PROG  ON,  EXPT  ON,  QUERY 
LOGICAL  PROG  ON,  EXPT  ON,  QUERY 
character  ihell*l 
ihell  =  char  (?) 


PROG  ON  =  .FALSE, 
write  (*,2)  ibell 
format  (lx,a,$) 

WRITE  (*,3)  I 
PORMATC  ERROR  '12'  -'$) 

GO  TO  (10 ,20 ,30 ,1*0 ,50 ,60 ,70 ,80 ,90 ,100  ,110 ,120  ,130  ,lLo  ,150 
160,170)  ,1 


WRITE  (»,12) 

FORMAT ( '  OOPS.  YOU  TYPED  A  CONTROL-C.  TYPE  EX  TO  EXIT.') 


RETURN 

20  WRITE  (*,22) 

22  FORMAT ( '  THAT  IS  NOT  A  COMMAND .  TYPE  HE  IF  YOU  NEED  HELP.') 

RETURN 

30  WRITS  (*,32) 

32  FORMAT' '  MI STEAK- IN  LINE.  PLEASE  RETYPE  IT. ' ) 

RETURN 

40  WRITE  (*,42) 

42  FORMAT ( '  VARIABLE  INDEX  OUT  OF  RANGE') 

RETURN 

50  WRITE  (*,52) 

52  FORMAT ( '  DO  LOOP  TO  NON-EXISTENT  LINE') 

RETURN 

60  WRITE  (*,62) 

62  FORMAT ( '  FIND  ERROR') 

RETURN 

TO  WRITE  (*,72) 

72  FORMAT ( '  GO  TO  NON  EXISTENT  LINE') 

RETURN 

30  WRITE  (*,32) 

82  FORMAT ( '  COMMANDS  ARE  ONE  OR  TWO  LETTERS  FOLLOWED  BY' 

1  /'  UP  TO  4  FLOATING  POINT  NUMBERS  (SEPARATED  BY  COMMAS) 

2  /'  FOR  A  LIST  OF  VALID  COMMANDS  TYPE  LC.') 

RETURN 

90  WRITE  (*,92) 

92  FORMAT ( 1  OPEN  ERROR') 

RETURN 

100  WRITE  (*,102) 

102  FORMAT ( '  LINE  NUMBER  MUST  BE  BETWEEN  1  AND  999') 

RETURN 

110  WRITE  (*,112) 

112  FORMAT ( '  NO  SUCH  LINE  NUMBER') 

RETURN 

120  WRITE  (*,122) 

122  FORMAT ( '  PROGRAM  BUFFER  PULL') 

RETURN 

130  WRITE  (*,132) 

132  FORMATC  OUTPUT  FILE  NOT  OPEN') 

RETURN 

140  WRITE  (*,142) 

142  FORMAT ( '  FILE  ALREADY  OPEN’) 

RETURN 

150  WRITE  (*,152) 

152  FORMAT ( '  NO  INPUT  FILE' ) 

RETURN 

160  WRITE  (*,162) 

162  FORMAT ( '  NO  FILES  OPEN') 

RETURN 

170  WRITE  (*,172) 

172  FORMATC  NO  FILE  OPEN  ON  THAT  LOGICAL  UNIT') 

RETURN 

C 

END 

SUBROUTINE  INIT 


o  a  o  o  o 


n 

C  INITIALIZE  PICAX  VARIABLES 

n 

u 

C  THIS  ROUTINE  IS  PART  OF  THE  PICAX  PROGRAM 

C  WRITTEN  BY  ROBERT  WALRAVSN ,  UCD  -  APPLIED  SCIENCE 

C  LAST  MODIFICATION  ON  19  SEP  3l 

C 

n 

COMMON  /P  C  VAR  /  NCVAR ,  CVAR(U) 

COMMON  /P  DO  VAR  /  DO  FRST,  DO  LAST,  DO  CNT 
common /p  flies /nopen, lunopn( 6) ,lunfnd(6) ,nfound, 
c  irecl(6)  ,irar(6)  ,irnv(6)  ,irnvmx{6) 

COMMON  /P  FLAGS  /  PROG  ON,  EXPT  ON,  QUERY 
COMMON  / PROGRM  /  NLINES,  N  LN  MAX,  PROG ( 50 ) 

COMMON  /P  TITLE  /  LTITLE(36) 

COMMON  /P  VAR  /  NCTRLC,  LN  PTR,  P  VERSN 
COMMON  /U  VAR  /  N  U  VAR,  U  VAR  (150) 

LOGICAL  PROG  ON,  EXPT  ON,  QUERY 
INTEGER  DO  FRST,  DO  LAST,  DO  CNT 
character  ltitle*2 

P  VERSN  *  2.0 
NCVAR  =  U 
N  LN  MAX  =  10 
NCTRLC  =  0 
NLINES  *  0 
DO  CNT  »  0 
PROG  ON  *  .FALSE. 

NOPEN  =  0 
NFOUND  =  0 
DO  1  I=l,o 
KJN  OPN  (I)  =  0 
1  LUN  FND  (I)  =  0 

EXPT  ON  =  .FALSE. 

QUERY  =  .FALSE. 

DO  20  1=1,35 
20  LTITLE(I)  =  '  1 

LTITLE(3 6)  =  char(  0  ) 

WRITE  (*,30)  P  VERSN 

30  FORMAT ( '  PICAX  VERSION  'F5.2'  12  September  1985’) 

CALL  UINIT 
RETURN 
END 

SUBROUTINE  INSERT 
C 

c - 

INSERT  A  LINE  INTO  THE  PROGRAM 

THIS  ROUTINE  IS  PART  OF  THE  PICAX  PROGRAM 
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COMMON  /P  C  VAR  /  NCVAR , 
COMMON  /P  INTER  /  LINE,  I 
COMMON  /P  MATCH  /  MCMND, 
COMMON  /PROGRM  /  NLINES, 
DIMENSION  N(2) 

EQUIVALENCE  (PACK,N(l)) 
character  icmnd*2,  chars*2 


/  NCVAR,  CVAR(U) 

/  LINE,  ICMND 

/  MCMND,  NMATCH,  CHARS,  MCHAR2 
/  NLINES,  N  LN  MAX,  PROG(50) 


IF  (NLINES  .GT.  0)  GO  TO  10 
NLINES  =  1 
INDEX  =  1 
GO  TO  90 

DO  20  INDEX  =  1, NLINES 
PACK  =  PROG(  INDEX*5-M 
IF  (N(l)  .EQ.  LINE)  GO  TO  90 
IF  (N(l)  .GT.  LINE)  GO  TO  HO 
CONTINUE 

INDEX  »  NLINES  1 

IF  (NLINES  .LT.  N  LN  MAX)  GO  TO  60 

CALL  ERROR (12) 

RETURN 

NLINES  *  NLINES  +  1 

IF  (INDEX  .GE.  NLINES)  GO  TO  90 

DO  80  J=NLINES,INDEX+1,-1 

M  »  ( J-l)*5 

DO  80  JJ*1,5 

NN  a  f^JJ 

PROG  (NN)  =  PROG  (NN-5) 

N(l)  a  LINE 
N(2)  a  NMATCH 
PR0G(INDEX*5-1»)  *  PACK 
DO  100  I-1,U 

PROG  (lNDEX*5+I-i‘)  »  C7AR(l) 

RETURN 

END 

SUBROUTINE  PLIST 


LISTS  THE  CURRENT  PROGRAM 


THIS  ROUTINE  IS  PART  OF  THE  PICAX  PROGRAM 
WRITTEN  BY  ROBERT  WALRAVEN,  UCD  -  APPLIED  SCIENCE 
LAST  MODIFICATION  ON  U  AUG  fl 0 


DESCRIPTION  OF  SYSTEM  COMMANDS 


LAST  MODIFICATION  ON  IT  JUL  *1 


This  program  *«bs  aodifiedfor  use  with  an  IBM-PCXT 
by  : 

Tom  Hargreaves 
JAYCOR 

205  S.  Whiting  St. 

Alexandria,  VA  2230L 

Last  modified  on  September  2 6,  1985 


SUBROUTINE  INFO (5) 

GO  TO  (100  ,200  ,300, LOO  ,500  ,600  ,700, BOO  ,900  ,1000  ,1100  ,1200  ,1300, 

1  1L00  ,1500 ,1600  ,1700 ,1800 ,1900  ,2000  ,2100  ,2200  ,2300  ,2h00 ,2500 , 

2  2600,2700,2800),  N 

LOO  WRITE  (*,110) 

L10  FORMATC  EXAMPLE:' /•  A  5,1E5'/ 

1  '  WILL  ADD  125  TO  VARIABLE  5.') 

RETURN 

-t 

200  CALL  QUANAL 
RETURN 


WRITE  (*,310) 

FORMATC  CLOSE  THE  DISK  OUTPUT  FILE.' /'EX:  "CL  N" '  / 

1  '  WILL  CLOSE  THE  FILE  ON  LOGICAL  UNIT  N.'/ 

2  '  IF  N  =  0  ,  THEN  THE  DEFAULT  LUN  (2)  IS  USED.'/ 

3  '  IF  NO  FILE  IS  OPEN,  COMMAND  IS  IGNORED.') 

RETURN 

WRITE  (»,LlO) 

FORMATC  DIRECTORY  LISTING:'/’  DI’/ 

1  '  PRODUCES  A  DIRECTORY  LISTING  ON  THE  CONSOLE.’/ 

2  '  DI  6’/'  PRODUCES  A  DIRECTORY  LISTING  ON  THE  LINE  PRINTER.'/ 

3  '  This  command  i3  not  currently  implemented.') 

RETURN 

WRITE  (*,510) 

FORMAT ( '  DO  LOOP:'/'  EXAMPLE:’/'  DO  30,5'/ 

1  ’  REPEATS  THE  SET  OF  INSTRUCTIONS  FROM  THE  CURRENT  LINE  TO  '/ 

2  ’  LINE  30  FIVE  TIMES.') 

RETURN 

WRITE  (», 610) 


olO  FORMAT ( ’  ERASES  CONSOLE  SCREEN.') 

RETURN 

C 

VOO  WRITE  (*,710) 

710  FORMAT  ( ’  CLOSES  OUTPUT  FILE  IF  OPEN  AND  EXITS  PROGRAM.  ' ) 

RETURN 

C 

300  WRITE  (*,8lO) 

8 10  FORMAT ( '  FIND  AN  OLD  DISK  INPUT  FILE.'/'  EX:  "FI  N  M "’/ 

1  '  WILL  CAUSE  PROGRAM  TO  ASK  FOR  "FILENAME".’/ 

2  '  REPLY  WITH  ANY  LEGAL  NAME,  SUCH  AS  "datal.dat". '/ 

3  '  THE  FILE  WILL  3E  OPENED  TO  LOGICAL  UNIT  NUMBER  N,'/ 

U  *  WITH  RECORD  LENGTH  M.  THE  DEFAULT  VALUES  FOR  N  AND  M' / 

•  5  '  (IF  SET  TO  0)  ARE  LUN  3  AND  RECORD  LENGTH  11700  BYTES.') 

RETURN 

C 

900  WRITE(*,910) 

910  FORMAT ( '  GO'/'  WILL  START  THE  PROGRAM  AT  THE  FIRST  LINE.'/ 

1  '  GO  25'/'  WILL  START  THE  PROGRAM  AT  LINE  25.') 

RETURN 

C 

1000  WRITE  (*,1010) 

1010  FORMAT ( '  HELP'/'  GIVES  THE  USER  A  LITTLE  USEFUL  INFO.’) 

RETURN 

C 

1100  WRITE  (*,1110) 

1110  FORMAT ( '  HC'/'  ISSUES  A  COMMAND  TO  THE  HARCOPY  UNIT  TO* 

1  /'  MAKE  A  COPY  OF  THE  CONSOLE  SCREEN.') 

RETURN 

C 

1200  WRITE  (*,1210) 

1210  FORMAT ( '  KILL  PROGRAM'/'  DELETES  THE  ENTIRE  CURRENT  PROGRAM.’/ 

1  '  TO  DELETE  A  SINGLE  LINE  OF  THE  PROGRAM,  TYPE  THE  LINE’/ 

2  '  NUMBER  FOLLOWED  BY  A  RETURN.') 

RETURN 

C 

1300  WRITE  (*,1310) 

1310  FORMAT ( '  LIST  COMMANDS'/'  LIST  THE  AVAILABLE  COMMANDS  AND', 

•  1  '  THEIR  BRIEF  DESCRIPTION.') 

RETURN 

C 

lUOO  WRITE  (*,1U10) 

lUlO  FORMAT ( '  LIST  PROGRAM'/’  LIST  THE  CURRENT  PROGRAM  AND’ 

1  '  COMMAND  VARIABLES.') 

RETURN 

C 

1500  WRITE  (*,1510) 

1510  FORMAT ( ’  LIST  VARIABLES'/'  LIST  THE  USER  VARIABLES , THEIR  VALUES,' 

1  '  AND  A  BRIEF  DESCRIPTION.’/ 

2  '  EX:  "LV  N'"/'  WILL  LIST  THE  FOLLOWING:'/ 


3 

'  N 

VARIABLES ' / 

k 

'  0 

EXPERIMENTAL 

PARAMETERS' / 

5 

'  1 

A-D  CHANNEL  NUMBERS'/ 

6 

'  2 

TRANS I AC  D-A 

CHANNEL  NUMBERS'/ 

CAMAC  SLOT  NUMBERS'/ 

TRANSIENT  RECORDER  ATTENUATOR  NUMBERS '  / 
PLOT  VARIABLES'/ 

TRANSIENT  RECORDER  NUTCBERS '  / 

DATA  TRANSLATION  CALIBRATION  FACTORS'/ 
TRANSIENT  RECORDER  CALIBRATION  FACTORS'/ 
TRANSIENT  RECORDER  ATTENUATOR  VALUES'/ 
DATA  TRANSLATION  DATA'/ 

TRANSIENT  RECORDER  DATA') 


RETURN 


WRITE  (*,l6lO) 

FORMAT ( '  OPEN  A  MEW  DISK  FILE  FOR  OUTPUT.'/'  EX:  "ON  M"'/ 

1  '  WILL  CAUSE  THE  PROGRAM  TO  ASK  FOR  A  "FILENAME".'/ 

2  '  REPLY  WITH  ANY  LEGAL  NAME,  SUCH  AS  "datal.dat”. '  / 

3  '  THE  FILE  WILL  BE  OPENED  TO  LOGICAL  UNIT  NUMBER  N,'/ 

U  '  WITH  RECORD  LENGTH  M.  THE  DEFAULT  VALUES  FOR  N  AND  M 7 

5  ’  (IF  SET  TO  0)  ARE  LUN  2  AND  RECORD  LENGTH  11700  BYTES.') 

RETURN 

CALL  QUPLOT 
RETURN 

WRITE  (*  ,1^10 ) 

FORMATC  PAUSE 7'  PAUSES  UNTIL  A  RETURN  IS  TYPED.’) 

RETURN 

CALL  QUPROC 
RETURN 

CALL  QUREAD 
RETURN 

CALL  QUSTRT 
RETURN 

WRITE  (*,2210) 

FORMATC  TITLE'/'  THE  NEXT  LINE  TYPED  WILL  BE  A  TITLE', 

1  '  FOR  THE  DATA.') 

RETURN 

WRITE  (*,2310) 

FORMATC  EXAMPLE:'/'  V3  =  1EV/'  WILL  SET  USER  VARIABLE  3  TO  1E5’) 
RETURN 

CALL  QUWRIT 
RETURN 


WRITE  (*,2510) 

FORMATC  EXAMPLE:’/'  WAIT  100’/ 

1  '  WILL  WAIT  FOR  100  TIMES  APPROXIMATELY  Q.2  MILLISECONDS,', 

2  '  OR  ABOUT  0.92  SECONDS.') 

RETURN 


»**************«****»«*»»***#***#*******»******##«#**«*******#******* 


userr.qo 

This  module  was  written  to  interface  PICAX  with 
the  Quasi-optical  gyrotron  experiment  at  the 
Naval  Research  Lab,  Washington  D.C. 

Written  by: 

Tom  Hargreaves 
JAYCOR 

205  S.  Whiting  St. 

Alexandria,  VA  2230U 


Last  modification: 


September  27 ,  19^5 


Q*****#*********«««*****«*****«*«««#*****«**«****#**********«***#*»*»»ft 


$ storage: 2 


SUBROUTINE  TTPLOT 


This  routine  plots  the  data. 


cvar  (l)  a  0 
1 
2 
3 
U 

5 

6 
7 

a 

9 

10 


Cathode  voltage  vs.  time 
Intermediate  voltage  vs.  time 
Cathode  current  vs.  time 
Collector  current  vs.  time 
Microwave  diode  vs.  time 
Interferometer  diode  vs.  time 
Interferometer  diode  vs.  mirror  spacing 
Microwave  diode  vs.  cathode  voltage 
Microwave  diode  vs.  cathode  current 
Microwave  diode  vs.  collector  current 
Microwave  diode  V3.  magnetic  field 


common  /pc  var  /  n  c  var,  c  var  (U) 

COMMON  /U  VAR  /  N  U  VAR,  U  VAR  (150) 

common  /  data  /  atten  (20),  datran  (l6,2),  trrec  ( 1000,10) 
freq  ( 1000  ,2),  data  ( 100,10) 

common  /  stp  num  /  n  stp  b,  n  stp  tp,  n  stp  v,  n  stp  cr, 
n  stp  al,  n  dat,  n  freq,  n  dat  ar 
common  /  datime  /  idate  (U),  itime  (U) 
dimension  time  (1000) 

dimension  yl(l000),  y2(l000),  y3(l000),  yU(lOOO),  y5(l000) 
dimension  errl(lOOO),  err2(l000),  err3(l000),  errU(looo), 
err5(l000) 

equivalence  (yl(l) ,trrec(l,l)) ,(errl(l) ,trrec(l,2)) , 

(y2(l) ,trrec(l,3)) ,(err2(l) ,trrec(l ,h) ) , 


c  (73(1) ,trrec(l,5) ) ,(err3(l) ,trrec(l,6) ) , 

c  (7M1)  ,trrec(l  ,? ) ) ,( errU(l)  ,trrec(l  ,8 ) ) , 

c  (75(1) ,trrec(l,9) ) ,(err5(l) ,trrec(l,10) ) 

dimension  freql  (1000),  pos  (1000) 
equivalence  (freql(l) ,freq(l,2) ) ,(pos(l) ,freq(l,l) ) 
dimension  76(100),  77(100),  78(100),  t9(100),  710(100) 
dimens  ion  err6 ( 100 ) ,  err7 ( 100 ) ,  err8 ( 100 ) ,  err9 ( 100 ) ,  err 10 ( 100 ) 
equivalence  (76(1) ,data(l,l) ) ,(err6(l) ,data(l ,2) ) , 
c  (77(1) ,data(l,3) ) ,(err7(l) ,data(l,U) ) , 

c  (78(1) ,data(l,5) ) ,(err8(l) ,data(l,6) ) , 

c  (79(1) ,data(l,7) ) ,(err9(l) ,data(l,8) ) , 

c  (710(1) ,data( 1 ,9 ) ) , ( errl0( 1 ) ,data( 1 ,10 ) ) 

character  xlabel*25 ,  7label*25 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


10 


For  the  x-axis  label  :  Jcolx  a  3^0  -  b  *  ncharx 

jrowx  =  10 

For  the  7-axis  label  :  JC0I7  =  8 

jroyy  =  100  +  k  *  nchary 
For  the  title  :  Jcolt  »  3^0  -  U  *  nchart 

Jrovt  *  189 

if(cvar(l)  .ge.  0.0  .and.  cvar(l)  ,le.  5.0)  then 

Calculate  the  time  array  (in  microseconds). 

deltat  »  1.0  /  30.0 
do  10  i  =  1,1000 
time  (i)  =  float  (i-l)  *  deltat 
nplot  »  101  +  ifix  (cvar(l)) 
nplot  *  ifix  (uvar( nplot ) ) 
npt  a  ifix  (uvar(l7  +  nplot)) 
if  (nplot  .eq.  0)  then 
write  (*,'("  No  data  for  plot. ' ' ) ' ) 
return 

elseif  (nplot  .eq.  l)  then 
call  uplotl  ( time ,7! , npt ) 
elseif  (nplot  .eq.  2)  then 
call  uplotl  (time ,72, npt) 
elseif  (nplot  .eq.  3)  then 
call  uplotl  ( t ime ,73 , npt ) 
elseif  (nplot  .eq.  1a)  then 
call  uplotl  ( t ime ,7k , npt ) 
elseif  (nplot  .eq.  5)  then 
call  uplotl  ( t ime , 75 , npt ) 
else 

write  (*,’(' •  Illegal  transient  recorder  number. ' ' ) ' ) 
return 
endif 

elseif  (cvar(l)  .eq.  6.0)  then 
npt  *  int  (uvar(l6)) 
call  uplotl  (pos , freql , npt ) 

elseif  (cvar(l)  .ge.  7.0  .and.  cvar(l)  ,le.  10. 0)  then 
npt  =  n  dat  ar 
if  (cvar(l)  .eq.  7.0)  then 


90 


call  uplotl  (y? ,76 ,npt) 
elseif  (cvar(l)  .eq.  8.0)  then 
call  uplotl  (y8,y6,npt) 
elseif  (cvar(l)  .eq.  9.0)  then 
call  uplotl  (y9,y6,npt) 
elseif  (cvar(l)  .eq.  10. 0)  then 
call  uplotl  (ylO ,y6, npt) 
endif 
else 

write  (*,'("  Plot  number  out  of  range.'')') 
return 
endif 

Do  axis  labeling  here. 

if  (cvar(l)  .ge.  0.0  .and.  cvar(l)  .le.  5.0)  then 
xlabel  =  'Time  (microsec)' 
ncharx  =  1 6 
Jcolx  *  276 

elseif  (cvar{l)  .eq.  6.0)  then 
xlabel  a  'Mirror  Spacing  (mm)' 
ncharx  =  20 
Jcolx  =  260 

elseif  (cvar(l)  .ge.  7.0  .and.  cvar(l)  .le.  10.0)then 
y label  =  'Microwave  diode' 
nchary  =  15 
Jrowy  =  160 

endif 

if  (cvar(l)  .eq.  0.0)  then 
y label  *  'Cathode  V  (kV)' 
nchary  =  15 
Jrowy  =  160 

elseif  (cvar(l)  .eq.  1.0 )  then 
ylabel  *  'Intermediate  V  (kV)' 

nchary  =  20 
Jrowy  =  180 

elseif  (cvar(l)  .eq.  2.0)  then 
ylabel  ■  'Cathode  I  (a) ' 
nchary  *  lU 
Jrowy  =  156 

elseif  (cvar(l)  .eq.  3.0)  then 
ylabel  =  'Collector  I  (a)’ 
nchary  *  16 
Jrowy  =  16U 

elseif  (cvar(l)  .eq.  U.0)  then 
ylabel  =  'Microwave  diode' 
nchary  =  15 
Jrowy  *  160 

el3eif  (cvar(l)  .eq.  5.0 )  then 
ylabel  =  'Interferometer  diode' 
nchary  a  20 
Jrowy  »  180 

elseif  (cvar(l)  .eq.  6.0)  then 
vlabel  *  'Interferometer  Diode' 


3.0)  then 
I  (A)’ 


U.0)  then 


5.0)  then 


nchary  *  20 
Jrowy  =  l8o 

elseif  (cvar(l)  .eq.  7.0 )  then 
xlabel  *  ' Cathode  V  ( kV) ' 
ncharx  =  15 
Jcolx  =  280 

elseif  (cvar(l)  .eq.  8.0)  then 
xlabel  *  'Cathode  I  (A) ' 
ncharx  =  lk 
Jcolx  *  28k 

elseif  (cvar(l)  .eq.  9.0)  then 
xlabel  =  'Collector  I  (A) ' 
ncharx  *  16 
Jcolx  =  276 

elseif  (cvar(l)  .eq.  10 .0)  then 
xlabel  =  'Magnetic  Field  (kG)' 
ncharx  =  20 
Jcolx  =  260 

endif 

call  qgtxt  (ncharx, xlabel, 3 , Jcolx, 10 ,0) 

call  qgtxt  ( nchary , y label, 3 ,8 .Jrowy ,-l) 

Print  the  time  and  date  that  the  data  was  taken. 

write  (*,'(57xi2"/”i2"/"iU"  ,  "i2"  :  "i2"  : " i2) ' ) 
idate(2),  idate(3),  idate(l),  (itime(i),  i  =  1,3) 

return 

end 

subroutine  uplotl  (  x,  y,  npt  ) 


This  routine  does  the  actual  plotting  as  well  as 
drawing  both  sets  of  axis. 


dimension  x(l000),  y(l000) 

common  /pc  var  /  n  c  var,  c  var  (U) 

COMMON  /U  VAR  /HU  VAR,  U  VAR  (150) 

Check  for  xst,  xfin,  yst,  and  yfin  (the  plot  boundaries) 

xst  *  uvar  (97) 
xfin  a  uvar  (98) 

call  rainmax  (xst,xfin,x,npt,xmaJor,nx) 
yst  »  uvar  (99) 
yfin  *  uvar  (100) 

call  minmax  (yst,yfin,y,npt,ymaJor,ny) 


Calculate  xmin,  xmax,  ymin,  ymax. 


xmin  =  xst  -  0.17  *  (xfin  -  xst) 

xmax  =  xfin  +  0.1  *  (xfin  -  xst) 

ymin  =  yst  -  0.23  *  (yfin  -  yst) 

ymax  *  yfin  +  0.11  *  (yfin  -  yst) 

Set  up  for  the  plot. 

iopt  *  0 

call  qplot  (0 ,639  ,0 ,199  , xmin, xmax, ymin, ymax, xsc , yst , 
iopt ,1.0 ,1.0) 
if  (iopt  .eq.  -2)  then 
write  (*,'("  Input  error 1 ' ) ' ) 
return 
endif 

call  qsetup  (0,3 ,-1,3) 

Plot  the  points  here. 

call  qtabl  ( 0 , npt , x ,y ) 

Plot  the  first  set  of  axis  here. 

call  qxaxis  (xst, xfin, xmajor ,l,l,nx) 
call  qyaxis  (yst,yfin,ymaJor,l,l,ny) 

Plot  the  second  set  of  axis  here. 

iopt  =  0 

call  qplot  (0,639,0,199,xmin,xmax,ymin,ymax,xfin,yfin 
iopt ,1.0 ,1.0) 
if  (iopt  .eq.  -2)  then 

write  (*,'("  Input  error  for  the  second  set  of  axis, 
return 
endif 

xmajor  =  -  xmajor 
yraaj or  =  -  ymajor 

call  qxaxis  (xst , xfin, xmajor ,1 ,0 ,0) 
call  qyaxis  ( yst , yfin  ,ymaj or ,1,0,0) 

return 
end 

subroutine  minmax  (rst,rfin,r,npt,rmaJor,n) 


This  routine  finds  the  minimum  and  maximum  of 
the  array  r.  It  also  calculates  some  of  the 
parameters  used  in  the  plotting  routines. 


dimension  r  (1000) 


if  (rst  .eq.  rfin)  then 
rst  *  aminl  (r(l),r(2)) 
rfin  =  amaxl  (r(l),r(2)) 
do  10  i  =  3,npt 
rat  =  aminl  (rat,r(i)) 
rfin  =  amaxl  (rfin,r(i)) 
dif  =  rfin  -  rat 
rat  =  rat  -  0.1  #  dif 
rfin  *  rfin  +  0.1  #  dif 
endif 

if  (rst  .eq.  rfin)  then 
if  (rst  .ne.  0.0)  then 
rat  a  0.95  *  rst 
rfin  =  1.05  *  rfin 
else 

rst  =  -1.0 
rfin  a  i.o 
endif 
endif 

We  need  1.0e6  >  rat, rfin  >  -1.0 e6 

if  (rat  ,gt.  1.0e6)  rst  *  i.0e6  -  1.0 
if  (rst  .It.  -1.0e6)  rst  *  -l ,0e6 
if  (rfin  .gt.  1.0e6)  rfin  *  i.0e6 
if  (rf.  .It.  -1.0e6)  rfin  =  -i.0e6  +1.0 


dif  *  aha  (rfin  -  rst) 

Calculate  the  distance  between  the  major  tic  marks 
and  pick  n  for  the  label  format  flO.n. 

tl  »  10.0 
n  3  0 

if  (dif  .gt.  5.0)  then 
do  20  i  »  1,5 
if  (dif  .le.  tl)  then 
rmajor  =  0.1  *  tl 
go  to  Uo 

elseif  (dif  .le.  (2.0  *  tl))  then 
rmajor  »  0.2  *  tl 
go  to  h-0 

elseif  (dif  .le.  (5.0  *  tl))  then 
rmajor  =  0.5  *  tl 
go  to  Uo 
endif 

tl  a  tl  *  10.0 

write  (*,’(”  Cannot  compute  the  tic  mark  spacing, 
rmajor  a  tl 
go  to  bo 
endif 

n  a  1 

tl  =  1.0 
do  30  i  a  1,8 


if  (dif  .gt.  (5.0  *  tl))  then 
major  =  tl 
go  to  Uo 

elseif  (dif  .gt.  (2.0  *  tl))  then 
major  =  0.5  *  tl 
go  to  Uo 

elseif  (dif  .gt.  tl)  then 
major  *  0.2  *  tl 
go  to  UO 
endif 
n  *  n  +  1 
tl  *  tl  *  0.1 

write  (*,'('•  Cannot  compute  the  tic  mark  spacing 

major  =  tl 

continue 

We  need  0  <=  n  <=  3 


if  (n  .gt.  3)  n  =  3 

rst  *  anint  ((rst  /  major))  *  major 
rfin  *  anint  ((rfin  /  major))  *  major 


return 


c********************************************************************** 

c 

c  userl.qo 

c  This  .nodule  was  written  to  interface  PICAX  with 

c  the  Quasi-optical  gyrotron  experiment  at  the 

c  Saval  Research  Lab,  Washington  D.C. 

c 

c  Written  by: 

c  Tom  Hargreaves 

c  JAYCOR 

c  205  S.  Whiting  St. 

c  Alexandria,  VA  2230k 

c 

c  Last  modification:  October  3,  19^5 

C 

£•*•******««***««*•»«***##•******«*»****«*»***•*»*******»*«#********•*» 


$ storage: 2 


SUBROUTINE  UAJJLYZ 


This  routine  will  calculate  the  peak  power  as  well  as  the 
efficiency  using  the  calorimeter  data  as  well  as  the  pulse 
shape,  voltage,  and  current  data  from  the  transient  recorders. 

If  the  transient  recorder  data  is  unavailable,  the  routine  will 
prompt  for  the  pulse  width,  and  will  use  the  voltage  and  current 
data  from  the  Data  Translation  card. 


cvar  (l)  »  0 
>  0 


Prompt  user  for  rep  rate. 
Rep  rate. 


COMMON  /U  VAR  /  N  U  VAR,  U  VAR  (l50) 
common  /pc  var  Inc  var,  cvar  (4) 

common  /  data  /  atten  (20),  datran  (16,2),  trrec  (1000,10), 
:  freq  ( 1000  ,2),  data  ( 100,10) 

Calculate  the  area  under  the  microwave  diode  curve  and  the 
corresponding  pulse  width  for  the  peak  power.  If  the  data 
is  not  available  from  the  transient  recorder,  then  ask  the 
user  for  the  pulse  width. 

Note:  It  is  assumed  that  the  diode  is  working  in  the  linear 
regime. 

p  width  ■  0.0 
p  max  *  0.0 
total  =0.0 
n  max  =  0 


*.  iN  '  >  *. 
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if  (uvar  (105)  .eq.  0.0)  then 

vrite  (*,'(' ’  The  microwave  diode  is  unavailable  from  the  ' ' 
c  1 ' transient  recorder. ' '  Enter  the  pulse  width  (sec)  :  ''$)' 
read  (*,*)  p  width 
else 

n  =  int  (uvar  (105)  *  2.0  -  1.0) 

do  10  i  *  l,int  (uvar  ( 17+ int  (uvar  (105)))) 

p  max  =  amaxl  (p  max.tr  rec(i.n)) 

if  (p  max  .eq.  tr  rec  (i.n))  n  max  =  i 

total  *  total  +  tr  rec  (i.n) 

Assume  that  the  transient  recorders  are  running  at  30  MHz. 
Therefor  the  points  are  33.3  nsec  apart. 

if  (p  max  ,ne.  0.0)  o  width  *  33.3e-Q  *  total  /  p  max 
endif 

Now  get  the  rep  rate.  If  cvar  (l)  *  0,  prompt  the  user. 

rep  rat  =  cvar  (l) 
if  (rep  rat  .eq.  0.0)  then 
write  (*,'(''  Enter  rep  rate  (Hz)  :  "$)') 
read  (*,*)  rep  rat 
endif 

Calculate  the  peak  power  (in  kW)  from  the  average  power  (in  watts) 
of  the  calorimeter. 

p  peak  *  0.0 

if (rep  rat  .ne.  0.0  .and.  p  width  .ne.  0.0 )  then 
p  peak  =  datran( int  (uvar  (U0) ) ,l)/(rep  rat  *  p  width  *  1000 .0) 
endif 

Get  the  cathode  voltage  from  the  transient  recorder  if  it  i3 
available,  otherwise  use  the  Data  Translation  data. 

volt  =0.0 
n  volt  *  0 

if  (uvar  (lOl)  .ne.  0.0  .and.  n  max  .ne.  0  .and. 
c  int(uvar(l7+int(uvar(l0l) ) ) )  .ge.  n  max)  then 
n  volt  =  int  (2.0  *  uvar  (lOl)  -  1.0 ) 
volt  =  tr  rec  (n  max.n  volt) 
else 

volt  =  datran  (int  (uvar  (35)),l) 
endif 

Get  the  collector  current  from  the  transient  recorder  if  it  is 
available,  otherwise  use  the  Data  Translation  data. 

cur  =  0.0 
n  cur  =  0 

if  (uvar  (103)  .ne.  0.0  .and.  n  max  .ne.  0  .and. 
c  int(uvar(l7+int(uvar(l03) ) ))  .ge.  n  max)  then 
n  cur  =  int  (2.0  *  uvar  (103)  -  1.0) 


c 

c 

c 


cur  =  tr  rec  (n  nax,n  cur) 
else 

cur  =  datran  (int  (uvar  ( 38 ) )  ,1 ) 
endif 


Calculate  the  efficiency  here, 
eta  =0.0 

if  (cur  .ne.  0.0  .and.  volt  .ne.  0.0)  then 
eta  =  p  peak  /  (volt  *  cur)  *  100.0 
endif 

Now  print  cut  the  results, 
write  (*,'(/ 

c  11  Diode  pulse  height  =  ''IpelO. 3"  volts'*/ 
c  ''  Pulse  width  =  "IpelO.  3"  seconds''/ 
c  "Rep  rate  =  "lpel0.3"  Hz"/ 
c  ' '  Cathode  voltage  =  ' ' IpelO .  3 ' '  kV  "  / 

c  "  Collector  current  =  "IpelO. 3"  Amps")') 

c  p  max,  p  width,  rep  rat,  volt,  cur 
write  (»,'(/"  Peak  power  =  "IpelO. 3"  kW"/ 
c  "  Efficiency  =  "IpelO. 3"  %'*)*)  p  peak,  eta 

RETURN 
END 


This  routine  initializes  the  variables  from  the 
user  written  subroutines. 


COMMON  /U  VAR  /  N  U  VAR,  U  VAR  (150) 
common/p  files/nopen,lunopn(6) ,lunfnd(6) ,nfound, 

irecl(6)  ,irnr(6)  ,irnw(6)  ,imwmx(6) 
common  /  data  /  atten  (20),  datran  (l6,2),  trrec  ( 1000 ,10), 
freq  ( 1000  ,2),  data  ( 100  ,10) 

common  /  stp  num  /  n  stp  b,  n  stp  tp,  n  stp  v,  n  stp  cr, 
n  stp  al,  n  dat,  n  freq,  n  dat  ar 
common  /  increm  /  del  b,  del  tp,  del  v,  del  cr,  del  al 
common  /  u  flags  /  strt  fl,  freq  fl,  base  fl,  n  dt  err,  dt  err 
logical  strt  fl,  freq  fl,  base  fl,  dt  err 
common  /  DT  2801  /  base  ad,  com  reg,  stat  rg,  dat  reg 
integer  base  ad,  com  reg,  stat  rg,  dat  reg 
common  /  datime  /  idate  (U),  itime  (U) 


The  date  and  time  arrays, 

do  5  i  =  1,U 
idate  ( i)  =  0 


itime  (i)  =  0 


The  user  variables. 

N  U  VAR  =  150 
do  10  i=l ,nuvar 
U  VAR  (i)  =  0.0 

The  read  and  write  variables 

do  20  i=l  ,6 
irecl  (i)  =  11700 
irnr  (i)  *  1 
irnvmx  (i)  =  0 
irnw  (i)  *  1 

The  data  arrays. 

do  30  i=l  ,20 
atten  (i)  =  0.0 
do  Uo  i=l  ,16 
do  U0  J=1 ,2 
datran  (i,j)  =  0.0 
do  50  1=1,1000 
do  50  J=l,10 
trrec  (i,j)  =  0.0 
do  60  i  =  1,1000 
do  60  J  =  1,2 
freq  (i,j)  =  0.0 
do  70  i  »  1,100 
do  70  J  =  1,10 
data  ( i , J )  =  0.0 

The  data  step  numbers. 

n  stp  b  =  1 
n  stp  tp  =  1 
n  stp  v  =  1 
n  stp  cr  =  1 
n  stp  al  =  1 
n  dat  =  0 
n  freq  =  1 
n  dat  ar  =  0 


strt  fl  =  .false, 
freq  fl  =  .false, 
base  fl  =  .true. 

Set  the  crate  number  to  1,  and  initialize  the  crate. 

call  crate  (l) 
call  camel  (l) 

Set  up  the  crate  for  DMA  input  and  output. 

call  dmaset  (1,2,1,1000) 

Start  the  Data  Translation  board  sampling. 

base  ad  =  #2ec 
com  reg  =  base  ad  +  1 
stat  rg  =  base  ad  +  1 
dat  reg  =  base  ad 

Stop  the  DT2801  board  read  any  Junk  data  and  then  clear  any  errors 

call  out  (com  reg,  #f) 

Junk  *  inp  (dat  reg) 
call  waitl  (stat  rg,  #4,  0) 
call  out  (com  reg,  #l) 

Set  the  clock  rate.  Send  the  command  byte  first. 

call  waitl  (stat  rg,  U,  0) 
call  out  (com  reg,  3) 

Send  the  clock  period  =  250  microseconds  *  2.5  microsec  *  100 
Jfote  that  the  clock  period  is  sent  as  two  bytes. 

Hote  that  99  *  2.5  microsec  is  the  minimum  period  that  allows 
the  subroutine  dtinp.asm  to  collect  the  data. 

call  waitl  (stat  rg,  2,  2) 
call  out  (dat  reg,  100 ) 
call  waitl  (stat  rg,  2,  2) 
call  out  (dat  reg,  0) 

Set  the  A-D  parameters.  Send  the  command  byte  first. 

call  waitl  (stat  rg,  1*,  0) 
call  out  (com  reg,  #d) 

Send  the  gain  code  =  0 

call  waitl  (stat  rg,  2,  2) 
call  out  (dat  reg,  0) 

Send  the  A-D  start  channel  »  0. 


call  vaitl  (stat  rg,  2,  2) 
call  out  (dat  reg,  0) 

Send  the  A-D  end  channel  =  15 

call  vaitl  (stat  rg,  2,  2) 
call  out  (dat  reg,  15) 

Send  the  number  of  A-D  conversions  =  16. 

Note  that  two  bytes  are  sent. 

call  vaitl  (stat  rg,  2,  2) 
call  out  (dat  reg,  1 6) 
call  vaitl  (stat  rg,  2,  2) 
call  out  (dat  reg,  0) 

Set  digital  port  0  for  aitput.  Send  the  command  byte  first. 

call  vaitl  (stat  rg,  2*,  0) 
call  out  (com  reg,  5) 
call  vaitl  (stat  rg,  2,  2) 
call  out  (dat  reg,  0) 

Set  all  bits  to  0  for  port  0.  Send  the  command  byte  first. 

call  vaitl  (stat  rg,  4,  0) 
call  out  (com  reg,  j) 
call  vaitl  (stat  rg,  2,  2) 
call  out  (dat  reg,  0) 
call  vaitl  (stat  rg,  2,  2) 
call  out  (dat  reg,  0) 

Check  for  any  errors. 

call  vaitl  (stat  rg,  4,  0) 
istat  *  inp  (stat  rg) 
if  (istat  .ge.  #80)  then 

Stop  the  DT2801  and  read  any  Junk  data. 

call  out  (com  reg,  #f) 

Junk  =  inp  (dat  reg) 

Send  the  read  error  register  command. 

call  vaitl  (stat  rg,  4,  o) 
call  out  (com  reg,  2) 

Read  the  error  register.  Note  that  there  are  tvo  bytes. 

call  vaitl  (stat  rg,  5,  0) 
ierrl  *  inp  (dat  reg) 
call  vaitl  (stat  rg,  5,  0) 
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ierrh  *  inp  (dat  reg) 


write(#,'(''  Error  initializing  the  Data  Translation  board.'')') 
write  (*,'('•  DT2801  error  register  low  byte  *  ' ' i3 ) ' )  ierrl 
write  (*,’("  DT2801  error  register  high  byte  ■  "13)')  ierrh 
endif 

RETURN 
END 


SUBROUTINE  UREAD  (LUN, lnum) 


This  routine  reads  record  number  imr  (lnum)  from 
logical  unit  number  lun. 


cvar(l)  =  0 

®  lun 


lun  =  3 


cvar(2)  *  0  imr(lnum)  =  next  record 

=  irnr  (lnum) 


common/p  files /nopen, lunopn( 6) ,lunfnd{6) ,nfound, 
c  irecl(6)  ,imr(6)  ,imw(6)  ,irnvmx(6) 

common  /pc  var  /  n  c  var,  cvar  (1>) 

COMMON  /U  VAR  /  N  U  VAR,  U  VAR  (150) 

common  /  data  /' atten  (20),  datran  (16,2),  trrec  (1000,10), 
c  freq  ( 1000 ,2),  data  ( 100 ,10) 

common  /  stp  num  /  n  stp  b,  n  stp  tp,  n  stp  r,  n  stp  or, 
c  n  stp  al,  n  dat,  n  freq,  n  dat  ar 

common  /  p  title  /  1  title  (36) 
character  1  title*2 

common  /  datime  /  idate  (U ) ,  itime  (h) 

if  (cvar(2)  .ne.  0.0)  imr(lnum)  =  cvar(2) 
read(  lun, rec=irnr( lnum)  ,end=100  ,err»110)irecln, 
c  nuvar,  (ltitle(i)  ,1*1,36) ,  (idate(i)  ,i«l,U) ,  (itime(i)  ,i=l,li) , 
c  (uvar(i) ,i»l, nuvar ) , 

c  (atten(i) ,i=l,20) , 

c  ( (datran(i,J )  ,i=l,l6)  ,J=1,2) , 

c  ((trrec(i,j),i=l,int(uvar(l7+((l+j)/2))))  ,J=1,10) , 

c  ( (freq(i,J ) , J=1 ,2 ) ,i=l,int(uvar(l6) ) ) 

write(*,'("  Record  number  "13"  is  "ifi"  bytes  long.'')') 
c  irnr  (lnum),  irecln 

irnr(lnum)  =  irnr(lnum)  +  1 

Put  data  into  the  accumulative  data  arrays. 

n  dat  ar  a  n  dat  ar  +  1 


o  n 


data  (n  dat  ar,l)  *  datran  (int(uvar(39) ) ,l) 

data  (n  dat  ar,2)  =  datran  ( int(uvar( 39) ) ,2) 

data  (n  dat  ar,3)  *  datran  (int(uvar(35) )  ,l) 

data  (n  dat  ar,b)  *  datran  ( int(uvar( 35 ) ) ,l) 

data  (n  dat  ar,5)  *  datran  (int(uvar(37) ) ,l) 

data  (n  dat  ar,6)  =  datran  ( int(uvar( 37) )  ,1) 

data  (n  dat  ar,7)  *  datran  (int(uvar(38) )  ,l) 

data  (n  dat  ar,8)  ■  datran  ( int(uvar(38) ) ,l) 

data  (n  dat  ar,9)  3  25.0  *  (datran  (int(uvar(3l) )  ,l)  /  118.8 

c  +  datran  ( int(uvar(32) ) ,l)  /  121. U) 
data  (n  dat  ar,10)  *  25.0  *  (datran  (int(uvar(3l) )  ,2)  /  118.8 
c  +  datran  ( int(uvar(32) ) ,2)  /  121. U) 

RETURN 

100  write  (*,'("  Attempt  to  read  past  end  of  file’')') 
return 

110  vrite( »,'("  Error  on  read*')') 
c 

RETURN 

END 


SUBROUTINE  UWRITE  (LUN,lnum) 
c 


c  This  routine  writes  record  number  irnw(lnum) 

c  of  length  irecl  to  logical  unit  number  lun. 

c 

c  cvar(l)  »  0  lun  *  2 

c  *  lun 

c 

c  cvar(  2 )  =*  0  imv  *  next  record 

c  *  imv 

c 

c - - - - - - - — - - - - — — — - — — - 

comnton/p  files /nopen, lunopn( 6)  ,lunfnd(6)  ,nfound, 
c  irecl(6)  ,lrar(6)  ,iraw(6)  ,imwmx(6) 

common  /pc  var  /  n  e  var,  cvar  (l») 

COMMON  /U  VAR  /  N  U  VAR,  U  VAR  (150) 

common  /  data  /  atten  (20),  datran  (l6,2),  trrec  (1000 ,10 ) , 
c  freq  (1000,2),  data  (100,10) 

common  /  stp  num  /  n  otp  b,  n  stp  tp,  n  stp  v,  n  stp  cr, 
c  n  stp  al,  n  dat,  n  freq,  n  dat  ar 

common  /  p  title  /  1  title  (36) 
character  1  title#2 

common  /  datime  /  idate  (2*),  itime  (b) 
c 

if  (int(cvar(2))  .gt.-  (imwmx(lnum)+l))  then 
write(*,,(''  Out  of  sequence  write  is  not  allowed  here.''/ 
c  * '  No  record  was  written.'')’) 
return 

elseif(cvur(2) .ne.0.0.and.int(cvar(2)) ,ne.(irnwmx(lnum)+l) )then 
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write(*,'(''  This  will  overwrite  record  number  1  '  i 3  *  1 
c  /''  Enter  1  to  overwrite,  0  to  abort  write. 1 ' ) 1 )i nt (cvar(2) ) 
read  (*,*)  test 
if  (test  .eq.  0.0)  return 
if  (test  .ne.  1.0)  go  to  20 
i  rnw(l  num)  =  cvar(  2) 
el  se 

i  rnwmx  (1  num)  *  i  rnwmx  (1  num)  +  1 
endi  f 
c 

c  Check  to  see  if  the  data  will  fit  in  one  record  length, 
c 

nbytes  3  734 
do  100  1*1,5 

100  nbytes  =  nbytes  +  8*i nt (uvar(17+i ) ) 
nbneed  *  nbytes  -  irecl  (lnum) 
if  (nbneed  .gt.  0)  then 

write(*,‘("  Attempt  to  write  past  end  of  record.*'/ 
c  1  *  No  data  was  written.'*/ 

c  lx , i 6 ' '  total  bytes  are  needed.'')')  nbytes 

return 
endi  f 
c 

c  Write  data  here, 
c 

write(l  un, err*  1000, rec=i  rnw(l  num)  )i  reel  (1  num) , 

c  nuvar,  (ltitl  e(i),i*l,36),  (idate(i ) ,i*l,4) ,  ( i time (i ),i*l,4) , 
c  (uvar(i ) ,i3l, nuvar) , 

c  (atten(i ) , i *1 ,20) , 

c  ( (datran(i ,j ) ,1*1,16) , j=l ,2 ) , 

c  ( (trrec(i  ,j  ) , i *1  ,i nt (uvar (17+(  (1+j  )/2) ) ) )  ,j3l  ,10) , 
c  ( (f req(i ,j ) ,j3l,2) ,i3l,int(uvar(16) ) ) 

write(*,'C'  Record  number  '  '  i  3* '  is  '  *  i  6' '  bytes  long'')1) 
c  irnw(lnum),  nbytes 

i  rnw  (lnum)  *  i  rnwmx  (lnum)  +  1 
RETURN 

1000  WRITE  (*,*)  'Error  on  write' 
c 

RETURN 

EN0 

c 

C . 

subroutine  uzero 

common  /  data  /  atten  (20),  datran  (16,2),  trrec  (1000,10), 
c  freq  (1000,2),  data  (100,10) 

common  /  stp  num  /  n  stp  b,  n  stp  tp,  n  stp  v,  n  stp  cr, 
c  n  stp  al ,  n  dat,  n  freq,  n  dat  ar 

c 

c  Zero  the  accumulative  data  array  here, 
c 

do  10  i  3  1,100 
do  10  j  3  1 ,10 
10  data  (i  ,j  )  3  0.0 
c 

n  dat  ar  3  0 
c 

RETURN 

END 
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£****»»»»»»»»»•»»*»*»«»****»**»**********«***««***#******#**#*****»*»** 

C 

c  user2.qo 

c 

c  This  module  was  written  to  interface  PICAX  with 

c  the  Quasi-optical  gyrotron  experiment  at  the 

c  Naval  Research  Lab,  Washington  D.C. 

c 

c  Written  by: 

c  Tom  Hargreaves 

c  JAYCOR 

c  205  S.  Whiting  St. 

c  Alexandria,  VA  2230H 


Last  modification: 


October  3,  1985 


$ storage: 2 
c 


SUBROUTINE  U  MATCH 


This  routine  defines  additional  (user  written)  commands 


logical  natch 

if(match(2T  ,'tr  '/Trigger  on/off 

’ ) ) return 

RETURN 

END 

SUBROUTINE  UCMNDS  (N) 

The  user  written  commands  are  executed  here 


common  /p  c  var /  n  c  var,  c  var  (U) 

common  /  DT  2801  /  base  ad,  com  reg,  stat  rg,  dat  reg 

integer  base  ad,  com  reg,  stat  rg,  dat  reg 


-Trigger  on/off 


if  (n  .eq.  2?)  then 
i  data  =  int  (cvar(l)) 


Send  the  data  to  port  0.  Send  the  command  byte  first 


call  vaitl  (stat  rg,  U,  0) 
call  out  (com  reg,  7) 
call  waitl  (stat  rg,  2,  2) 
call  out  (dat  reg,  0) 
call  vaitl  (stat  rg,  2,  2) 
call  out  (dat  reg,  i  data) 
return 
endif 

RETURN 

END 

SUBROUTINE  UINFO  (N) 


This  routine  gives  information  about  the  user  written  commands 


if  (n  ,eq.  27) 

then 

write  (*,270) 

format  ('  Trigger  on/off'// '  ex:  "tr  n"  will:'// 

'  n  =  0 

Turn  trigger  off.'/ 

>  '  n  =  1 

return 
endif 

Turn  trigger  on. ' ) 

RETURN 

END 

SUBROUTINE  UVLIST 


This  subroutine  lists  the  user  variables. 

Different  variables  are  listed  depending  on  the  value 
of  variable  cvar(l). 


cvar(l)  * 


variables  numbered  1-30 
variables  numbered  31-1*6 
variables  numbered  1*7-62 
variables  numbered  63-75 
variables  numbered  76-96 
variables  numbered  97-100 
variables  numbered  101-110 
variables  numbered  111-130 
variables  numbered  131-lUO 
attenuator  values 
datran  (i,j) 

trrec  (i,j)  for  channel  cvar(2) 


common  /pc  var  /  n  c  var,  c  var  (U) 

COMMON  /U  VAR  /  N  U  VAR,  U  VAR  (150) 

common  /  data  /  atten  (20) ,  datran  (l6,2),  trrec  (1000,10), 
c  freq  ( 1000 ,2),  data  ( 100  ,10) 

common  /  p  title  /  1  title  (36) 
character  type*l,  string*35,  1  title*2 
common  /  datime  /  idate  (U),  itime  (U) 

write(*,'("  Title:  ",36a2)')  1  title 

write  (*,*("  Experiment  date  and  time  :  *  *12' 7* 'i2"/' 'ifc 

c  "  ,  "12":  "12":  "12)')  idate  (2),  idate  (3),  idate  (l) 
c  ( itime( i) ,  i  =  1,3) 
n  a  1  cvar  (l) 

go  to  (10  ,20 ,30  ,U0 ,50 ,60 ,70  ,B0 ,90 ,1 ,100  ,110 ,120 )  n 
vrite(*,*("  Parameter  out  of  range.'*)') 
call  info  (15) 
return 

List  experimental  parameters  here. 

vrite(*,'("  List  of  experimental  parameters.'’')') 
type  *  'r' 

string  *  'Initial  cavity  magnetic  field  (kG) . ' 

call  define  (l, type, string) 

string  »  'Final  cavity  magnetic  field  (kG).' 

call  define  (2, type, string) 

type  «  »i* 

string  =  'Number  of  steps. ' 
call  define  (3, type, string) 
type  =  'r' 

string  a  'initial  cavity  field  taper  (?»).' 

call  define  (U, type, string) 

string  *  'Final  cavity  field  taper  (?*).' 

call  define  (5 ,type, string) 

type  a  • i • 

string  =  'Number  of  steps.' 
call  define  (6, type, string) 
type  »  'r' 

string  *  'initial  e-beam  voltage  (kV).' 

call  define  (7, type, string) 

string  *  'Final  e-beam  voltage  (kV).' 

call  define  (8 , type, string) 

type  *  * i ’ 

string  *  'Number  of  steps.' 
call  define  (9, type, string) 
type  a  'r' 

string  a  'initial  e-beam  current  (A).' 
call  define  (10, type, string) 
string  »  'Final  e-beam  current  (a).* 
call  define  (11, type, string) 
type  »  'i' 


string  *  'Number  of  steps.' 
call  define  (12, type, string) 
type  =  'r' 

string  *  'Initial  e-beam  alpha.' 
call  define  ( 13, type, string) 
string  *  'Pinal  e-beam  alpha.' 
call  define  (ll*  .type,  3t  ring) 
type  =  'i' 

string  =  'Number  of  steps.' 

call  define  ( 15 .type, string) 

string  *  'Number  of  interferometer  points.' 

call  define  (l6, type, string) 

string  *  'Number  of  shots/pt.  to  avg.  over.' 

call  define  ( 17, type, string) 

string  =  'Number  of  pts.  for  tran.  rec.  1.' 

call  define  ( 18 , type, string) 

string  »  'Number  of  pts.  for  tran.  rec.  2.’ 

call  define  ( 19, type, string) 

string  a  'Number  of  pts.  for  tran.  rec.  3.* 

call  define  (20 , type, string) 

string  =  'Number  of  pts.  for  tran.  rec.  1*.' 

call  define  (21 , type, string) 

string  a  'Number  of  pts.  for  tran.  rec.  5.' 

call  define  (22, type, string) 

return 

List  analog-digital  channel  numbers  here. 

vrite(*,'("  List  of  Data  Translation  channel  numbers 
type  a  '  i' 

string  a  'Supercon  top  coil  current,' 

call  define  (31 .type, string) 

string  *  'Supercon  bottom  coil  current.' 

call  define  (32, type, string) 

string  »  'Trim  top  coil  current.' 

call  define  (3 3, type, string) 

string  *  'Trim  bottom  coil  current.' 

call  define  (3** .type, string) 

string  a  'Cathode  voltage.' 

call  define  (35 .type, string) 

string  *  ' Intermediate  anode  voltage . ' 

call  define  (36 .type, string) 

string  »  ' cathode  current . ' 

call  define  (37, type, string) 

string  =  'Collector  current.' 

call  define  ( 3^ , type , st  ring ) 

string  =  'Microvave  diode.' 

call  define  (39, type, string) 

string  *  'Calorimeter.' 

call  define  (1*0 , type, string) 

string  =  'Interferometer  position.' 

call  define  (1*1 , type, string) 

string  *  'Interferometer  diode.' 

call  define  (1*2, type, string) 


return 


List  Trans iac  digital -analog  channel  numbers  here. 

vrite(*, ' ( ' '  Transiac  digital-analog  channel  numbers. ' ' ) ' ) 
type  =  ' i ' 

string  *  'Supercon  top  coil  current.’ 

call  define  (U'T  .type, string) 

string  *  'Supercon  bottom  coil  current.' 

call  define  (U8, type, string) 

string  *  'Trim  top  coil  current.' 

call  define  (U9, type, string) 

string  *  'Trim  bottom  coil  current.' 

call  define  ( 50 , type, string) 

string  *  'Cathode  current.’ 

call  define  (51, type, string) 

string  =  'Collector  current.' 

call  define  (52, type, string) 

return 

List  Camac  slot  numbers  here. 

vrite( *,'(''  Camac  slot  numbers .'')') 
type  *  ' i* 

string  *  'Controller.' 

call  define  (63 , type, string) 

string  *  'Digital-analog  converter.' 

call  define  (6U , type, string) 

string  *  'Hex  attenuator.' 

call  define  (65 , type, string) 

string  *  'Differential  amplifier. ' 

call  define  (66, type, string) 

string  *  'Transient  recorder  number  1.’ 

call  define  (67, type, string) 

string  ■  'Transient  recorder  number  2.’ 

call  define  (68 , type, string) 

string  =  'Transient  recorder  number  3.' 

call  define  (69 , type, string) 

string  *  'Transient  recorder  number  U.' 

call  define  (70 , type, string) 

string  *  'Transient  recorder  number  5.’ 

call  define  (71, type, string) 

return 

List  the  attenuator  numbers  for  the  transient  recorders  here 
Hex  attenuators  are  numbers  1-6. 

Differential  amplifier  is  number  7. 

* 

vrite(*,'(''  Attenuator  numbers  (Differential  amp  is  7)'')') 
vrite(*,' ( /' '  Hote:  These  are  applied  only  to  the  transient'' 
:  ' '  recorder  data. ' ' ) ’ ) 

type  *  ’  i ' 

string  *  'Humber  of  attenuators  (20  aaxiiaim) . ' 
call  define  (76 , type, string) 


string  *  'Superconductor  top  coil  current.' 

call  define  (77 , type, string) 

string  *  'Superconductor  bottom  coil  current.' 

call  define  (78, type, string) 

string  *  'Top  trim  coil  current.' 

call  define  (79, type, string) 

string  3  'Bottom  trim  coil  current.' 

call  define  (80 , type, string) 

string  *  ' Cathode  voltage . ' 

call  define  (8l, type, string) 

string  *  'Intermediate  anode  voltage.' 

call  define  (82, type, string) 

string  *  'Cathode  current.' 

call  define  (83 , type, string) 

string  3  'Collector  current.' 

call  define  (84 , type, string) 

string  3  'Microwave  diode.' 

call  define  (85 .type, string) 

string  3  'Calorimeter.' 

call  define  (86 , type, string) 

string  *  'Interferometer  position.' 

call  define  (87, type, string) 

string  3  'Interferometer  diode.' 

call  define  (88 , type, string) 

return 

List  plot  variables  here. 

Write( *,'(''  Plot  variables. "  ) ' ) 
type  3  '  r' 

string  3  'X-axis  minimum.' 
call  define  (97 , type, string) 
string  3  'X-axis  maximum. ' 
call  define  (98 , type, string) 
string  3  'Y-axis  minimim. ' 
call  define  (99 .type, string) 
string  3  'Y-axis  maxiasim. ' 
call  define  (100 .type, string) 
return 

List  the  number  of  the  transient  recorder  used  to 

measure  each  parameter  here. 

vrite(*,'(''  Transient  recorder  associated  with  each 
:  ' 'parameter. ' ' ) ' ) 

type  3  'i' 

string  3  ' Cathode  voltage . ' 
call  define  ( 101 .type, string) 
string  3  'Intermediate  anode  voltage.' 
call  define  (102 .type, string) 
string  3  'Cathode  current.' 
call  define  (103, type, string) 
string  3  'Collector  current.' 
call  define  (104 .type, string) 


string  »  Microwave  diode.' 
call  define  ( 105 , type, 3tring) 
string  =  'Interferometer  diode.' 
call  define  ( 106 , type, string) 
return 

List  calibration  factors  for  the  DT2801  here. 

vrite(#,'(''  Calibration  factors  for  the  Data  Translation'' 
c  ' '  card  only. ' ' ) ' ) 
type  *  'e' 

string  =  'Supercon  top  coil  current  (a/V)' 

call  define  (ill , type, string) 

string  =  'Supercon  bottom  coil  current  (A/V)' 

call  define  (112, type, string) 

string  =  'Trim  top  coil  current  (A/V)' 

call  define  ( 113, type, string) 

string  =  'Trim  bottom  coil  current  (a/V)' 

call  define  (llU .type, string) 

string  =  'Cathode  voltage  (kV/V)' 

call  define  ( 115 .type, string) 

string  =  'Intermediate  anode  voltage  (kV/V)’ 

call  define  (ll6, type, string) 

string  a  'Cathode  current  (A/V)' 

call  define  (117, type, string) 

string  =  'Collector  current  (a/V)' 

call  define  ( 118 , type, string) 

string  a  'Microwave  diode  (kW/v)' 

call  define  (119 .type, string) 

string  *  'Calorimeter  (W/V)' 

call  define  (120 , type, string) 

string  a  'Interferometer  position  (mills/v)' 

call  define  (121, type, string) 

string  a  'interferometer  diode  (W/V)' 

call  define  (122, type, string) 

return 

List  calibration  factors  for  transient  recorders. 

vrite(*,'(''  Calibration  factors  for  the  transient  recorder 
' '  data  only. ' ' ) ' ) 

type  =  ' e ' 

string  3  ' Cathode  voltage  ( kV /V ) ' 

call  define  ( 131 .type, string) 

string  =  'Intermediate  anode  voltage  (kV/V)' 

call  define  ( 132, type, string) 

string  =  'Cathode  current  (A/v)' 

call  define  (133 .type, string) 

string  *  'Collector  current  (A/V)' 

call  define  ( 131*  .type, string) 

string  *  'Microwave  diode  (kW/v)' 

call  define  ( 135 .type, 3tring) 

string  a  'Interferometer  diode  (kW/V)' 

call  define  (136 , type, string) 


return 


List  attenuator  values  here. 

00  writeC*,^''  Attenuator  number'  '10x'  'Value' ')' ) 

do  105  i«l,T 

05  vrite(*,' (7x,i3 ,l^x,lpe!2.5) ' )i,atten( i) 
return 

List  Data  Translation  data  (datran( i,J ) }  here. 

10  vrite(*,’("  Channel' '10x' 'Mean' *10x' 'Mean  square'')') 

do  115  i=l,l6 

15  write( * , ' ( Ux, i2 ,7x,lnel2 .5 ,12x ,lpel2 .5 ) ' ) i , ( datran( i ,J ) 

c  J-1,2) 
return 

List  transient  recorder  data  here  (trrec( i ,J ) ) . 

20  istrt  =  1 

iend  *  9 

if  (cvar(2)  .gt.  0.0  .and.  cvar(2)  .le.  5.0)  then 
i3trt  =  2.0  *  cvar(2)  -  1.0 
iend  =  2.0  *  cvar(2)  -  1.0 
endif 

do  125  i=istrt,iend,2 
num  =  ( i+l)  /  2 

write(#,'("  Transient  recorder  number  ",i2)')  num 
write{  *,'(/"  Point  "10x'  'Mean"  lOx”  Mean  square'')') 
do  125  J=*l  ,int(uvar(l7+num) ) 

25  write(#,'(lx,iU ,6x,lpel2.5 ,6x,lpel2.5) ’ )j ,( trrec( J ,k) , 
c  k=i,(i+l)) 

RETURN 
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Q********************************************************************** 

c 

C  user3.qo 

c 

c  This  module  was  written  to  interface  PICAX  with 
c  the  Quasi-optical  gyrotron  experiment  at  the 

c  Naval  Research  Lab,  Washington  D.C. 

c 

c  Written  by: 

c  Tom  Hargreaves 

c  JAYCOR 

c  205  S.  Whiting  St. 

c  Alexandria,  VA  2230k 


Last  modification: 


September  26 ,  1985 


£**#***********************«**»**«»*«***#*«»**##*»***»***************** 


$  storage :  2 


SUBROUTINE  QUANAL 
write  ( * ,100 ) 

format  ('  Analyze  the  data'/ 

'  This  routine  will  calculate  the  peak  power  and  the  peak'/ 

'  efficiency  using  the  calorimeter  data,  the  microwave  diode'/ 
'  data  (if  available)  and  the  current  values  of  the  user'/ 

•  variables.'//’  ex:  an  m'/ 

'  where:  m  =  0  will  prompt  for  the  rep  rate'/ 

*  =  rep  rate  ’ ) 

RETURN 


SUBROUTINE  QUPLOT 
write  (*,100 ) 

format  ('  Plot  the  data'/’  ex:  "pi  n"  will  plot:'/'  n’5x'plot'/ 
'  0  Cathode  voltage  vs.  tine'/ 

’  1  Intermediate  voltage  vs.  time'/ 

’  2  Cathode  current  V3.  time'/ 

'  3  Collector  current  vs .  time ' / 

'  U  Microwave  diode  vs.  time'/ 

'  5  Interferometer  diode  vs.  time'/ 

'  6  Interferometer  diode  vs.  mirror  spacing'/ 

'  T  Microwave  diode  vs.  cathode  voltage'/ 

'  8  Microwave  diode  vs.  cathode  current'/ 

'  9  Microwave  diode  vs.  collector  current'/ 

'  10  Microwave  diode  vs.  magnetic  field') 


RETURN 
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SUBROUTINE  QUPROC 
write  (*,100) 

100  format  ('  Proceed'/'  This  command  will  restart  the  experiment' 
1  1  from  the  point  where  it  was  interupted. ' ) 

c 

RETURN 

END 

c 

C . 

SUBROUTINE  QUREAD 
write  (*,100) 

100  format  ('  Read  a  record  from  a  disk  file'/1  ex:  "r  n  m'"/ 

1  '  will  read  record  number  m  from  logical  unit  number  n.'/ 

2  '  m  =  0  will  read  the  next  record.'/ 

3  '  n  =  0  will  read  from  the  default  LUN  (3).') 
c 

RETURN 

ENO 

c 

C . 

SUBROUTINE  OUSTRT 
write  (*,100) 

100  format  ('  Start  the  experiment'/'  ex:  "s  n  m"'/ 


1 

'  n  =  0 

will 

take  the  normal  data.'/ 

2 

'  n  =  1 

will 

scan  the  interferometer.'/ 

3 

'  m  =  0 

will 

subtract  the  baseline  from  the  transient 

4 

' recorder 

data. 7 

5 

'  m  ><  0 

will 

not  subtract  the  oaseline.') 

RETURN 

ENO 


C . 

SUBROUTINE  QUWRIT 
write  (*,100) 

100  format  ('  Write  a  record  to  a  disk  file'/'  ex:  "w  n  m'"/ 

1  '  will  write  record  number  m  to  logical  unit  number  n.'/ 

2  '  m  *  0  will  write  the  next  record.'/ 

3  '  n  *  0  will  write  to  the  default  LUN  (2).') 
c 

RETURN 

END 

c 

C . 

SUBROUTINE  QUZERO 
write  (*,100) 

100  format  ('  Zero'/'  will  zero  the  accumulative  data  arrays.') 


RETURN 

END 


O  <J 


£  *•*★*■****■**•**★★**•*★'*■#***'*•»*★*'*★**★*★■* •***•**■**•****•*★*★**★*****•«'•■»******* 
c  user4.qo 

c 

c  This  module  was  written  to  interface  PICAX  with 
c  the  Quasi -optical  gyrotron  experiment  at  the 

c  Naval  Research  Lab,  Washington  O.C. 
c 

c  Written  by: 

c  Tom  Hargreaves 

c  JAYCOR 

c  205  S.  Whiting  St. 

c  Alexandria,  VA  22304 

c 

c  Last  modification:  October  1,  1985 

c 

Q  **■****★***•****■*★*★*★★**★★**★★★*★**★***•*★*****■***■**★*★******★★•*  *★**+★* 

c 

c 

$storage:2 

c 

c 

subroutine  sc  b  set  {b .taper, func) 
c 

c - 

c 

c  This  routine  services  the  superconducting  magnet, 
c 

c  func  =  0  Set  the  magnet  currents, 

c  func  =  1  Check  to  see  if  the  magnet  has  charged 

to  full  current  yet.  Set: 
func  *  0  if  done, 
c  func  3  1  if  not  yet  done, 

c 

c - 

c 

c  See  the  addendum  to  the  users  manual  for  the  derivation  of 

c  the  formulae  for  the  two  current  values, 

c  This  routine  makes  use  of  the  following  facts: 
c 

c  1)  For  a  level  field  at  50  kG: 
c  top  coil  current  s  118.8  amps 

c  bottom  coil  current  =  121.4  amps 

c 

c  2)  The  power  supply  level  is  programmed  as: 
c  0  volts  *>  0  amps 

c  -6  vol  ts  *>  150  amps 

c 

c  3)  The  minutes  full  scale  is  still  programmed  at  the  power  supply, 
c  See  section  III,  figure  5a  in  the  IGC  magnet  manual, 

c 

c  4)  The  Transiac  3016  OAC  has  a  resolution  of  or  -  3  millivolts 
c  which  corresponds  to  +  or  -  75  mill  i amps  at  the  magnet. 
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common  /  data  /  atten  (20),  datran  (l6,2),  trrec  (1000,10), 
c  freq  (1000,2),  data  (100,10) 

COMMON  /U  VAR  /  N  U  VAR,  U  VAR  (150) 

if  (func  .eq.  0.0)  then 

Calculate  the  voltages  to  send  to  the  DAC. 

top  cur  =  (-b)  *  (taper  *  117.15  -  10515.0 )  /  (taper  *  22,19  + 
c  1138.0) 

bot  cur  =  b  *  (taper  #  258.13  +  10TT5.0)  /  (taper  *  22.19  + 
c  1138 .0) 

top  vol  =  (-top  cur)  *  6.0  /  150.0 
bot  vol  *  (-bot  cur)  *  6.0  /  150.0 

Ensure  that  the  two  voltage  values  are  between  0  and  -1.88  volts 

if  (top  vol  .gt.  0)  top  vol  »  0.0 

if  (top  vol  .It.  -1.88)  top  vol  =  -1.88 

if  (bot  vol  .gt.  0)  bot  vol  »  0.0 

if  (bot  vol  .It.  -1.88)  bot  vol  *  -1.88 

n  d  top  =  nint  (top  vol  *  3276.7) 
n  d  bot  =  nint  (bot  vol  *  3276.7) 

Get  the  camac  slot  number  and  the  DAC  channel  numbers. 

n  *  int  (uvar  (61)) 
n  a  top  *  int  (uvar  (I7)) 
n  a  bot  »  int  (uvar  (18)) 
nq  »  0 
nx  a  0 

call  camo  (n,  16,  n  a  top,  n  d  top,  nq,  nx) 
if  (nq  .ne.  l)  write  (*,'("  Q  a  ' 'll"  while  attempting  ' ' 
c  "to  set  the  top  superconductor  current . "  ) ' )  nq 

nq  =  0 

nx  =  0 

call  camo  (n,  16,  n  a  bot,  n  d  bot,  nq,  nx) 
if  (nq  .ne.  l)  write  (*,'("  Q  a  ’'ll"  while  attempting  " 
c  "to  set  the  bottom  superconductor  current.")’)  nq 

Set  up  for  DMA  again 

call  dma3et  (1,2,1,1000) 
return 

elseif  (  func  .eq.  1.0 )  then 

Compare  the  measured  current  to  the  desired  current. 

if  (abs  (top  cur  -  datran  (int  (uvar  (31 ) ) ,1 ) )  .le.  O.l)  then 
if  (abs  (bot  cur  -  datran  (int  (uvar  (32)),l))  .le.  0.1)  then 
func  a  o.O 


Th±3  routine  sets  the  electron  gun  voltage. 
fUnc  *  0  Set  the  voltage. 

func  *  1  Check  to  see  if  the  modulator  is  fully 

charged  yet.  Set: 
fUnc  »  0  if  done, 

func  »  1  if  not  yet  done. 


func  ®  0.0 

return 

end 


subroutine  cur  set  (cur, func) 


fUnc  *  1 


if  not  yet  done 


fane  *  0.0 

return 

end 

subroutine  gt  attn  (att) 


Thi3  routine  gets  the  attenuator  values  from  the 
Camac  crate.  It  also  gets  the  differential  amplifier 
value.  The  values  are  stored  in  array  att(20)  : 

1-6  Lecroy  Rl02  hex  attenuator. 

T  Trans lac  differential  amplifier. 


COMMON  /U  VAR  /  N  U  VAR,  U  VAR  (150) 

dimension  att  (20) 

integer  d,  q,  x 

do  10  i«l ,20 

att(i)  *  0.0 

Set  hex  attenuator  slot  number  to  n. 

n  =  uvar  (65) 
do  20  i  *  1,6 
x  =>  0 
d  »  0 
q  *  0 

call  cami  (n,0 ,i,d,q,x) 
if(x  ,ne.  l)  then 

write( *,*(**  Error  reading  attenuator  number  ' ' i3 ) ' )  i 

go  to  20 

endif 

att  (i)  *  1.0/float( ( (d*5)  /  *0 ) 
continue 


Set  differential  amplifier  slot  number  to  n. 

n  *  uvar  (66) 
x  ■  0 
d  *  0 
q  a  0 

call  cami  (n,0  ,0  ,d,q,x) 
if(x  ,ne.  l)  then 

vrite( *,'(''  Error  reading  differential  amplifier' ' )' ) 
return 


c  If  d  >  6k  then  filter  is  in. 

c 

if  (d  .gt.  62*)  d  *  d  -  128 
att  (7)  *  0.05 

if  (d  .gt.  0)  att  (7)  *  float  (d)  /  10.0 
if  (d  .gt.  2)  att  (7)  *  float  (d)  /  8.0 
if  (d  .gt.  16)  att  (7)  =  float  (d)  /  6.1* 
c 

c  Set  up  for  DMA  again 
c 

call  dmaset  (1,2,1,1000) 
return 
end 
c 

subroutine  real  dt 
c 

e - - - - — - - - 

c 

c  This  routine  converts  the  raw  data  from  the  Data 

c  Translation  card  into  read,  world  units, 

c 

c  Note  that  the  data  in  array  dat  (i,2)  is  squared, 

c 

c— - - - - - - — — - - - 


common  /  data  /  atten  (20),  datran  (l6,2),  trrec  (1000,10), 
c  freq  ( 1000 ,2),  data  ( 100,10) 

COMMON  /U  VAR  /Nil  VAR,  U  VAR  (150) 
c 

ffcc  -  20.0  /  2*096.0 
do  100  i  -  1,16 
c 

c  Find  the  parameter  associated  with  this  data, 
c 

n  *  0 

do  10  J  «  31,U2 

if  (i  .eq.  int  (uvar(j)))  n  »  J  -  30 
10  continue 
c 

c  Nov  get  the  calibration  factor, 

c 

cal  *  1.0 

if  (uvar  (110+n)  .ne.  0.0)  cal  ■  uvar  (110+n) 
if  (n  .eq.  0)  cal  ■  1.0 
c 

c  Nov  convert  the  data, 

c 

datran  (i,*  cal  *  (datran  (i,l)  •  fac  -  10.0 ) 

100  datran  (i,2)  =  (cal#(sqrt( datran  (i,2))  *  fac  -  10. 0))  **  2 
c 

return 

end 


subroutine  real  tr 


c 

c 

c 

c 

c 

c 

c 

c 

c> 

c 


c 

c 

c 


c 


c 

c 

c 


10 


c 

c 

c 

c 

20 

c 

c 
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This  routine  converts  the  rav  data  from  the  mransiac 
trasient  recorders  into  real  world  units. 

Note  that  the  data  in  trrec  (i,J  )  ,J=2,U , . . .  is  squared. 

base  fl  *  .true.  Subtract  baseline. 

*  .false.  Do  not  subtract  baseline. 


common  /  data  /  atten  (20).  datran  (l6,2),  trrec  (1000,10), 
c  freq  (1000,2).  data  ( 100, 10) 

COMMON  /U  VAR  /HU  VAR,  U  VAR  (150) 
common  /pc  var  /  n  c  var,  c  var  (U) 

common  /  u  flags  /  strt  fl,  freq  fl,  base  fl,  n  dt  err,  dt  err 
logical  strt  fl,  freq  fl,  base  fl,  dt  err 

This  raitine  is  set  up  for  a  maximum  of  5  transient  recorders. 

do  100  J  *  1,5 

if  ( int (uvar ( 17+J ) )  .le.  0)  go  to  100 

n  *  int  (uvar(66+j)) 
nx  *  0 
nq  *  0 
nd  a  0 

Get  the  attenuator  value  and  the  calibration  factor  here. 

att  »  1.0 
cal  *  1.0 
do  10  i  3  1,5 

if  (irrt(uvar(l00+i) )  .eq.  j)  then 
if  ( int(uvar(80+i) )  .ne.  0)  att  a  atten  ( int(uvar(8o+i) ) ) 
if  (uvar  (l30+i)  .ne.  0.0)  cal  =*  uvar  (l30+i) 
endif 
continue 

if  ( int ( uvar ( 106 ) )  .eq.  j)  then 
if  ( int (uvar (88) )  .ne.  0)  att  »  atten  ( int (uvar (88) ) ) 
if  (uvar  (136)  .ne.  0.0)  cal  a  uvar  (136) 
endif 

Put  the  variance  of  the  data  (sigma**2)  into  tr  rec  (i,2*j). 
sigma**2  *  <x**2>  -  <x>**2 

do  20  i  »  I,int(uvar(l7+J ) ) 

tr  rec  (i,2#j)  a  tr  rec  (i,2#j)  -  (tr  rec  ( i,2#J-l)**2) 

If  base  fl  is  false,  then  don't  get  the  offset  data, 
if  (.not.  base  fl)  go  to  U5 


I 
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Get  the  data  offset  from  the  transient  recorder 
and  add  it  to  the  data. 


In  order  to  read  the  offset  correctly,  there  nust  be  no  trigger 
pulse  until  at  least  700  microseconds  after  the  F(2*O#a(0) 
camac  call.  Therefore,  start  this  sequence  immediately  after 
a  trigger  pulse.  This  method  should  be  good  for  rep  rates  up 
to  at  least  100  Hz. 

do  25  i*l,2 

call  camo  (n,8  ,0 ,nd,nq,nx) 
if  (nq  .ne.  l)  go  to  23 
call  camo  (n,9,0,nd,nq,nx) 

if  (nq  .ne.  l)  write  (*,'("  Q  *  "ik"  while  attempting  " 
c  ' 'to  start  sampling  for  transient  recorder  ''i2)')  nq,  J 
call  camo  (n,26 ,0 ,nd,nq,nx) 

if  (nq  .ne.  l)  write  (*,'("  Q  •  *  * iU  * '  while  enabling  the  " 
c  ''LAM  for  transient  recorder  ''i2)')  nq,  J 
continue 

call  camo  (n,27 ,0 ,nd,nq,nx) 

if  (nq  .ne.  l)  write  (*,'("  Q  *  ''iU*'  while  attempting  " 
c  ''to  read  offset  for  transient  recorder  f'i2)')  nq,  J 

Test  the  LAM  to  see  if  the  transient  recorder  data 
is  ready  to  be  read  by  the  computer. 

call  camo  (n,8 ,0,nd,nq,nx) 
if  (nq  .ne.  l)  go  to  30 

Head  the  data  here. 

do  Uo  i  *  I,int(uvar(l7+J ) ) 
call  canri.  (n,2,0,nd,nq,nx) 

tr  rec  (i,2*J-l)  ■  tr  rec  (i,2*J-l)  -  float  (nd) 
if  (nq  .eq.  0)  write  (*,'("  0.  *  0  for  transient  recorder  " 
c  "data  point  "i2"  ,  " iU ) ' )  i,j 
continue 
continue 

Restart  the  transient  recorder  sampling  and  set 
up  the  LAM  again. 

call  camo  (n,9 ,0 ,nd,nq,nx) 

if  (nq  .ne.  l)  write  (*,'("  Q  =  "iU"  while  attempting  " 
c  "to  start  sampling  for  transient  recorder  "i2)')  nq,  J 
call  camo  (n,26  ,0 ,nd,nq,nx) 

if  (nq  .ne.  l)  write  (*,'("  Q  *  "iU"  while  enabling  the  " 
c  "LAM  for  transient  recorder  "i2)')  nq,  J 


Convert  the  data  here, 
do  50  i  *  l,int  (uvar(l7+j)) 


00^00000 


£•#•••*»****»**»##**»#****»********»»**»*#**************«**«««*#»***#** 

c 

c  user5.qo 

c 

c  This  nodule  vas  written  to  interface  PTCAX  with 

c  the  Quasi-optical  gyrotron  experiment  at  the 

c  Naval  Research  Lab,  Washington  D.C. 

c 

c  Written  by: 

c  Tom  Hargreaves 

c  JAYCOR 

c  205  S.  Whiting  St. 

c  Alexandria,  VA  2230k 

c 

Last  modification:  September  27,  19S5 


storage : 2 


SUBROUTINE  UPDATE 
C 

c— — - — . . ,  - — . . . .  . . .  . . 

c 

c  This  routine  takes  the  data  from  the  experiment, 

c  If  freq  fl  is  true  then  only  the  interferometer 

c  data  is  taken, 

c 

c— — . . . . . . . . — 

COMMON  /P  FLAGS/  PROG  ON,  EXPT  ON,  QUERY 
common  /pc  var  /  n  c  var,  c  var  (U) 

COMMON  /U  VAR  /  N  U  VAR,  U  VAR  (150) 

common  /  data  /  atten  (20),  datran  (l6,2),  trrec  ( 1000,10), 
c  freq  (1000,2),  data  ( 100,10) 

common  /  stp  num  /  n  stp  b,  n  stp  tp,  n  stp  v,  n  stp  cr, 
c  n  stp  al,  n  dat,  n  freq,  n  dat  ar 

common  /  increm  /  del  b,  del  tp,  del  v,  del  cr,  del  al 
common  /  u  flag3  /  strt  fl,  freq  fl,  base  fl,  n  dt  err,  dt  err 
logical  strt  fl,  freq  fl,  base  fl,  dt  err 
LOGICAL  PROG  ON,  EXPT  ON,  QUERY 

c 

c  Get  the  data  from  the  Data  Translation  board, 

c 

call  gt  dtm 
c 

c  Check  for  an  error  reading  the  DT2fl01. 
c 

if  (dt  err)  return 
if  (.not.  freq  fl)  then 
c 

c  Get  the  data  from  the  Camac  crate. 


call  gt  tree 
endif 

Check  the  number  of  data  shots  taken  so  far. 
n  dat  =  n  dat  +  1 

if  (n  dat  .It.  int(uvar(lT) ) )  return 

Average  the  data  here. 

do  100  i«l,l6 
do  100  j-1,2 

dat ran  (i,j)  =  datran  (i,j)  /  uvar  { 17 ) 
if  (.not.  freq  fl)  then 
do  110  J-1,5 

do  110  i*l,int(uvar(l?+J ) ) 

trrec  (i,2*J-l)  3  trrec  (i,2*J-l)  /  uvar  (IT ) 
trrec  (i,2*j)  3  trrec  (i,2*j)  /  uvar  C IT ) 
endif 

Convert  the  data  into  real  world  units, 
call  real  dt 

If  freq  fl  is  true  then  put  the  interferometer 
data  into  the  array  freq. 

if  (freq  fl)  then 

freq  (nfreq,l)  *  datran  (int(uvar(Ul) ) ,l) 

freq  (nfreq,2)  *  datran  ( int(uvar(42)  5 ,2) 

n  freq  *  n  freq  +  1 

if  (n  freq  .It.  int(uvar( 16) ) )  return 

n  dat  3  0 

else 

call  real  tr 
endif 

Put  data  into  the  accumulative  data  arrays, 
n  dat  ar  ®  n  dat  ar  +  1 

data  (n  dat  ar,l)  3  datran  ( int(uvar(39) ) ,1 ) 

data  (n  dat  ar,2)  3  datran  (int(uvar(39) ) ,2) 

data  (n  dat  ar,3)  3  datran  (int(uvar(35) ) ,l) 

data  (n  dat  ar,4)  =  datran  (int(uvar(35) )  .l) 

data  (n  dat  ar,5)  *  datran  (int(uvar(3T) ) ,l) 

data  (n  dat  ar,6)  *  datran  (int(uvar(37) ) ,l) 

data  (n  dat  ar,7)  3  datran  ( int(uvar( 38 ) ) ,l) 

data  (n  dat  ar,8)  3  datran  (int(uvar(38) ) ,l) 

data  (n  dat  ar,9)  *  25.0  *  (datran  ( int(uvar(3l) ) ,l)  /  ll8.fi 

c  +  datran  (int(uvar(32) ) ,1)  /  121. U) 
data  (n  dat  ar,10)  3  25.0  #  (datran  ( int(uvar(3l) ) ,2)  /  llfl.fi 
c  +  datran  (int(uvar(32) ) ,2)  /  121.4) 


c 

c 

c 

SUBROUTINE  UPROCD 

c 

c 

This  routine  restarts 

the  experiment  after  it  has 

c 

been  interrupted. 

c 

If: 

c 

n  dat  >=  n  dat  max 

then:  Increment  the  parameters. 

c 

zero  the  data  arrays,  and 

c 

return. 

c 

n  dat  <  n  dat  max 

then:  return. 

c - 

c 

common  /p  flags/  prog  on,  expt  on,  query 
common  /pc  var  /  n  c  var,  c  var  (k) 

COMMON  /U  VAR  /  N  U  VAR,  U  VAR  (150) 

common  /  data  /  atten  (20),  datran  (16,2),  trrec  ( 1000,10), 
c  freq  ( 1000 ,2),  data  ( 100,10) 

common  /  stp  num  /  n  stp  b,  n  stp  tp,  n  stp  v,  n  stp  cr, 
c  n  stp  al,  n  dat,  n  freq,  n  dat  ar 

common  /  increm  /  del  b,  del  tp,  del  v,  del  cr,  del  al 
common  /  u  flags  /  strt  fl,  freq  fl,  base  fl,  n  dt  err,  dt  err 
logical  strt  fl,  freq  fl,  base  fl,  dt  err 
logical  prog  on,  expt  on,  query 
common  /  datime  /  idate  (U),  itime  (k) 
c 

c  Check  to  see  if  the  experiment  has  been  started  yet. 

c 

if  (.not.  strt fl)  then 

vrite( *,'(''  The  experiment  has  not  been  started  yet.'')’) 

return 

endif 

expt  on  *  .true. 

if(ndat  .It.  int(uvar(l7) ) )  go  to  2000 
c 

c  Get  the  current  time  and  date, 
c 

call  qtime  (itime(l) ,itime(2) ,itime(3) ,itime(U)) 
call  qdate  ( idate(l) ,idate(2) ,idate(3) ) 
c 

c  Set  n  dat  =  0,  zero  the  data  arrays,  increment  the 

c  parameters,  check  the  parameters,  get  the  new  (?) 

c  attenuator  values,  and  return. 
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do  10  i-1,20 
atten  (i)  =  0.0 
do  20  i=l,l6 
do  20  J=1 ,2 
datran  (i,j)  =  0.0 
do  30  1=1,1000 
do  30  J-1,10 
trrec  (i,j)  =0.0 
n  freq  =  1 
do  U0  i  =  1,1000 
do  1*0  J  =  1,2 
freq  (i,J )  =0.0 

Do  the  voltage  first. 

n  stp  v  *  n  stp  v  +  1 

if(n  stp  v  .gt.  int(uvar(9) ) )  n  stp  v  =  1 
volt  =  uvar(7)  +  delv#float(n  stp  v  -  l) 
call  v  set  (volt,0) 
if(n  stp  v  ,ne.  l)go  to  95 

Do  the  current  next. 

n  stp  cr  =  n  stp  cr  +  1 

if(n  stp  cr  .gt.  lnt(uvar{ 12) ) )  n  stp  cr  =  1 
cur  =  uvar(lO)  +  del  cr*float(n  stp  cr  -  l) 
call  cur  set  (cur,0) 
if( n  stp  cr  .ne.  l)go  to  95 

Do  alpha  next. 

n  stp  al  =  n  stp  al  +  1 

if(n  stp  al  .gt.  int(uvar(l5) ) )  n  stp  al  =  1 
al  *  uvar(l3)  +  del  al*float(n  stp  al  -  l) 
call  tr  b  3et  (al,0) 
if  (n  stp  al  .ne.  l)  go  to  95 

Do  the  taper  next. 

n  stp  tp  =  n  stp  tp  +  1 

if(n  stp  tp  .gt.  int(uvar(6) ) )  n  stp  tp  =  1 
tp  =  uvar(lt)  +  del  tp*float(n  stp  tp  -  l) 

Check  to  see  if  the  magnetic  field  needs  to 
be  Incremented  also. 

if(n  stp  tp  ,eq.  l)  then 

n  stp  b  =  n  stp  b  +  1 

if(n  stp  b  .gt.  int(uvar( 3) ) )  then 

expt  on  =  .false. 

vrite  Experiment  complete. 'V  '  •''$)') 

return 


b  =  uvar(l)  +  del  b* float (n  stp  b  -  l) 
call  sc  b  set  (b,tp,0) 

95  continue 

c  Get  the  attenuator  values  here, 

c 

call  gt  attn  (atten) 
n  dt  err  =  0 

99  test  nm  =  0.0 

100  continue 

test  nm  =  test  ran  +  1.0 
if  (test  nm  .ge.  10. 0)  then 

vrite( *,’(''  System  not  yet  ready.’1/''  Enter  1  to  bypass 
c  1 ' checks,  0  to  continue  checking.'')') 

read  (*,*)  test 
if  (test  .eq.  1.0)  go  to  1000 
go  to  99 
endif 

call  dt  strt 
110  call  gtdtrn 

if  (dt  err)  go  to  110 
call  realdt 
test  =  1.0 

call  sc  b  set  ( 0,0, test) 
if  (test  .ne.  0.0)  go  to  100 
test  »  1.0 

call  tr  b  set  (o,test) 

if  (test  .ne.  0.0)  go  to  100 

test  *  1.0 

call  v  set  (0,test) 

if  (test  .ne.  0.0)  go  to  100 

test  =1.0 

call  air  set  (0,test) 
if  (te3t  .ne.  0.0)  go  to  100 
1000  continue 
c 

c  Zero  the  data  array  datran  (l6,2)  again, 
c 

do  1010  i*l  ,16 
do  1010  J»l,2 
1010  datran  (i,j)  =  0.0 
2000  continue 
c 

c  Wait  for  a  trigger  on  the  Data  '"nans lat ion  board, 

c  then  restart  the  data  sampling, 

c 

call  dt  3trt 
c 

c  Restart  the  transient  recorder  sampling  and  set 
c  up  the  LAM  again, 
c 


do  3000  i  **  1,5 


if  (uvar  (lT+i)  .eq.  0.0)  go  to  3000 
a  *  int  (uvar  (66+ i)) 
nd  =  0 
nq  *  0 
nx  *  0 

call  camo  (n,9 ,0 ,nd,nq,nx) 

if  (nq  .ne.  l)  write  (*,'("  0.  =  "iL"  while  attempting  " 
c  "to  start  sampling  for  transient  recorder  "i2)')  nq,  i 
call  camo  (n,26 ,0 ,nd,nq,nx) 

if  (nq  .ne.  l)  write  (*,’("  Q  *  "iU"  while  enabling  the  " 
c  "LAM  for  transient  recorder  "i2)')  nq,  i 
3000  continue 
c 

RETURN 

END 

c 

C - 

c 

SUBROUTINE  USTART 
c 

c— — — - - — — — . .  . . -  -  -  - - - — - - - - 

c 

c  This  routine  sets  the  experimental  parameters  (i.e.  magnetic 

c  field,  etc.)  in  preparation  for  data  taking.  The  actual,  data 

c  taking  is  done  in  subroutine  update.  The  data  arrays  are  also 

c  zeroed  in  this  routine. 


c 


c 

cvar  (l)  »  1.0 

a> 

Take  interferometer  data. 

c 

c 

cvar  (2)  *  0.0 

a> 

Subtract  baseline  from  transient 

c 

recorder  data. 

c 

><  0.0 

=> 

Do  not  subtract  baseline. 

c 

C — - - - - - - - - — - - - - - — - - - 

c 

common  /pc  var  /  n  c  var,  c  var  (U) 

COMMON  /U  VAR  /  N  U  VAR,  U  VAR  (150) 

common  /  data  /  atten  (20),  datran  (l6,2),  trrec  (1000,10), 
c  freq  ( 1000  ,2),  data  ( 100,10) 

common  /  stp  num  /  n  stp  b,  n  stp  tp,  n  stp  v,  n  stp  cr, 
c  n  stp  al,  n  dat,  n  freq,  n  dat  ar 

common  /  increm  /  del  b,  del  tp,  del  v,  del  cr,  del  al 
common  /  u  flags  /  strt  fl,  freq  fl,  base  fl,  n  dt  err,  dt  err 
logical  strt  fl,  freq  fl,  base  fl,  dt  err 
common  /  datime  /  idate  (It),  itime  (k) 
c 

c  Get  the  current  time  and  date, 
c 

call  qtime  (itime(l) ,itime(2) ,itime(3) ,itime(k) ) 
call  qdate  (idate(l) ,idate(2) ,idate(3)) 
c 


Initialize  the  data  arrays  here, 
do  10  i  *  1,16 


do  10  j  »  1,2 

10  datran  (i,j)  =  0.0 

do  20  i  *  1,1000 
do  20  J  =1,10 
20  trrec  (i,j)  =  0.0 

freq  fl  =  .false, 
do  30  i  *  1,1 000 
do  30  J  =  1,2 
30  freq  (i,j)  =  0.0 

do  hO  1  *  1,100 
do  U0  J  *  1,10 
U0  data  (i,j)  =  0.0 

c 

c  Set  the  experimental  parameters  here, 

c 

call  sc  b  set  (uvar(l) ,uvar(U) ,0) 
call  tr  b  set  (uvar(l3),0) 
call  v  set  (uvar{7),0) 
call  cur  set  (uvar(l0),0) 
c 

c  Initialize  the  step  numbers  here, 

c 

n  dat  ar  *  0 
n  stp  b  =  1 
n  stp  tp  =  1 
n  3tp  v  *  1 
n  stp  cr  =  1 
n  stp  al  =  1 
c 

c  Calculate  the  increments  here, 

c 

del  b  a  o.o 

if  (uvar(3)  .gt.  1.0)  then 

del  b  =  (uvar(2)  -  uvar(l))  /  (uvar(3)  -  1.0 ) 

endif 

del  tp  *  0.0 

if  (uvar(6)  .gt.  1.0)  then 

del  tp  =  (uvar(5)  -  uvar(U))  /  (uva r(6)  -  1.0) 
endif 

del  v  a  o.O 

if  (uvar(9)  .gt.  1.0)  then 

del  v  »  (uvar(fl)  -  uvar(7))  /  (uvar(9)  -  1.0 ) 

endif 

del  cr  =  o.O 

if  (uvar{l2)  .gt.  1.0)  then 

del  cr  a  (uvar(ll)  -  uvar(lO))  /  (uvar(l2)  -  1.0 ) 
endif 

del  al  *  0.0 

if  (uvar(l5)  .gt.  1.0)  then 

del  al  »  (uvar(lU)  -uvar(l3))  /  (uvar(l5)  -  1.0) 

endif 

c 

c  Check  to  see  if  the  parameters  have  been  set  yet. 

c  i.e.  is  the  supercon  magnet  up  to  field  yet? 
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a  ; 


vo 


Get  the  attenuator  values  here 


call  gt  attn  (atten) 
n  dt  err  =  0 
95  test  na  =  0.0 
100  continue 

test  na  =  test  na  +  1 
if  (test  na  .ge.  10. 0)  then 

vrite(*,'(''  System  not  ready  yet.,,/',  Enter  1  to  bypass ’’ 
c  ”  checks,  0  to  continue  checking. *  * ) * ) 

read  (*,*)  test 
if  (test  ,eq.  1.0)  go  to  1000 
go  to  95 
end  if 

call  dt  strt 
110  call  gtdtrn 

if  (dt  err)  go  to  110 
call  realdt 
test  *  1.0 

call  sc  b  set  ( 0,0 .test) 
if  (test  .ne.  0.0 )  go  to  100 
test  =1.0 

call  tr  b  set  (0,test) 

if  (test  .ne.  0.0)  go  to  100 

test  =1.0 

call  v  set  (0,test) 

if  (test  .ne.  0.0)  go  to  100 

test  =1.0 

call  cur  set  (0,test) 
if  (test  .ne.  0.0)  go  to  100 
1000  continue 
c 

c  Zero  the  data  array  datran  (l6,2)  again, 
c 

do  1010  i=l ,l6 
do  1010  J-1,2 
1010  datran  (i,j)  =0.0 
c 

c  Start  the  transient  recorders  saapling,  enable  the  LAM, 
c  and  enable  the  computer  readout. 

c 

c  !Tote:  l)  Save  no  pre-trigger  samples. 

c  2)  Sample  interval  =  33.3  nsec  for  Data  Translation 

c  model  200fif. 

c 

do  2000  i  =  1,5 
nq  *  0 
nx  *  0 

ad  *  3 

if  (uvar(lT+i)  .le.  512.0)  nd  =  h 

if  (uvar(l7+i)  .le.  256.0)  nd  =  5 

if  (uvar(l7+i)  .le.  128.0)  nd  *  6 


if  (uvar(l?+i)  .le.  64.0)  nd  a  7 
nd  a  nd  *  64 

if  (uvar(l7+i)  .ne.  0.0)  then 

n  »  int  (uvar(66+i)) 

call  camo  (n,l6 ,0 ,nd,nq,nx) 

if  (nq  .ne.  l)  write  (*,'("  Q  =  "i4"  while  attempting  to 
c  ’’initialize  transient  recorder  ’ ’ i2 ) ’ )  nq,  i 
endif 
continue 

Set  the  final  parameters. 


n  dat  =  0 

n  dt  err  =  0 

strt  fl  »  .true. 

freq  fl  *  .false. 

if  (cvar(l)  .eq.  1.0 )  freq  fl  * 

base  fl  ®  .true. 

if  (cvar(2)  .ne.  0.0)  base  fl  =* 


.true. 


.false, 


Wait  for  a  trigger  on  the  Data  Translation  board, 
then  restart  the  data  sampling. 

call  dt  strt 

Restart  the  transient  recorder  sampling  and  set 
up  the  LAM  again. 

do  3000  i  *  1,5 

if  (uvar  (l7+i)  .eq.  0.0)  go  to  3 000 
n  a  int  (uvar  (66+ i)) 
nd  a  o 
nq  ■  0 
nx  *  o 

call  camo  (n,9 ,0 ,nd,nq,nx) 

if  (nq  .ne.  l)  write  (*,’(’’  Q  a  "14"  while  attempting  " 
c  "to  start  sampling  for  transient  recorder  "i2)’)  nq,  i 
call  camo  (n,26 ,0 ,nd,nq,nx) 

if  (nq  .ne.  l)  write  (*,’("  Q  =  "14”  while  enabling  the 
c  "LAM  for  transient  recorder  "12)’)  nq,  i 
continue 

RETURN 


subroutine  dt  strt 


This  routine  returns  after  the  second  trigger  pulse  to  the 
Data  Translation  board. 


common  /  DT  2801  /  base  ad,  coo  reg,  stat  rg,  dat  reg 
integer  base  ad,  com  reg,  stat  rg,  dat  reg 


Stop  the  DT2801,  read  any  Junk  data,  and  clear  any  errors. 
Send  the  start  read  command  and  vait  for  a  trigger. 

Do  this  twice  and  then  start  the  experiment  on  the  third  loop 

do  100  i  *  1,3 

Stop  the  DT2801,  read  any  Junk  data,  and  clear  any  errors. 

call  out  (com  reg,  #f) 

Junk  =  inp  (dat  reg) 
call  waitl  (stat  rg,  4,  0) 
call  out  (com  reg,  #l) 

Send  the  start  read  command. 

call  waitl  (stat  rg,  U,  0) 

call  out  (com  reg,  #8e) 

if  (i  .It.  3)  call  waitl  (stat  rg,  5,  0) 

continue 

return 

end 

subroutine  gt  dtrn 


This  routine  gets  the  data  from  the  Data  Translation 
board.  The  data  is  placed  into  the  array  datran  (l 6,2) 
by  the  assembly  language  routine  input  (datran).  The  data 
is  placed  a3  follows: 

datran  (i,l):  data 

datran  (i,2):  square  of  data  (for  error  analysis) 


common  /  data  /  atten  (20) ,  datran  (l6,2),  trrec  (1000,10), 
c  freq  (1000,2),  data  ( 100,10) 

COMMON  /U  VAR  /  IT  U  VAR,  U  VAR  ( 150 ) 

common  /  DT  2801  /  base  ad,  com  reg,  stat  rg,  dat  reg 

integer  base  ad,  com  reg,  stat  rg,  dat  reg 

common  /  u  flags  /  strt  fl,  freq  fl,  base  fl,  n  dt  err,  dt  err 
logical  strt  fl,  freq  fl,  base  fl,  dt  err 
dimension  dt  temp  (l6,2) 


dt  err  *  .false 


■  Ut  L.  -  Jh*  ■  J.'  I-'  w'  I 


Get  the  input. 

call  dtinpl  (dt  temp) 

Check  for  any  errors. 

call  waitl  (stat  rg,  #4,  0) 
istat  »  inp  ( stat  rg ) 
if  (istat  .ge.  #80)  then 
dt  err  ■  .true, 
n  dt  err  *  n  dt  err  +  1 

Stop  the  DT2801  and  read  any  Junk  data. 

call  out  (coo  reg,  #f) 

Junk  *  inp  (dat  reg) 

Send  the  read  error  register  command, 

call  waitl  (stat  rg,  4,  0) 
call  out  (com  reg,  2) 

Read  the  error  register.  Note  that  there  are  two  bytes. 

call  waitl  (stat  rg,  5,  0) 
ierrl  *  inp  (dat  reg) 
call  waitl  (stat  rg,  5,  0) 
ierrh  *  inp  (dat  reg) 

if  (ierrl  .ne.  0  .or.  ierrh  .ne.  4)  then 

write  (*,'("  DT28oi  error  register  low  byte  »  *  *  13 ) ' )  ierrl 
write  (*,'("  DT2801  error  register  high  byte  *  "i3)')  ierrh 
pause  'This  data  point  will  be  ignored.  Hit  return  to  continue.' 
endif 

Compare  the  number  of  errors  so  far  to  0.1  *  (number  of  data 
points ) . 

if  (n  dt  err  ,gt.  (l+int(0.1*uvar(l7) ) ) )  then 
write(*,’("  There  have  been  "i3"  DT  2801  errors  so  far.")') 
c  n  dt  err 

pause  'Hit  return  to  reset  the  error  count  and  continue.' 
n  dt  err  *  0 
endif 

VEait  for  a  trigger  on  the  Data  Translation  board, 
then  restart  the  data  sampling. 

call  dt  strt 

Restart  the  transient  recorder  sampling  and  set 
up  the  LAM  again. 

do  3000  i  *  1,5 


-''S'  • 


*  '  •  *  »  » *  *  *  ■  *  «i 


if  (uvar  (17+i)  .eq.  0.0)  go  to  3000 
n  *  int  (uvar  (66+ i)) 
ad  *  0 
nq  *  0 
ax  *  0 

call  camo  (a, 9 ,0 ,nd,nq,nx) 

if  (aq  .ae.  l)  vrite  (*,'("  Q  =  "iU"  while  attempting  " 
c  "to  start  sampling  for  traasieat  recorder  ''12)')  nq,  i 
call  camo  (a, 26 ,0 ,nd,nq,nx) 

if  (nq  .ne.  l)  write  (•,'("  Q  *  ’’iU''  while  enabling  the  " 
c  "LAM  for  traasient  recorder  "i2)')  aq,  i 
3000  continue 
else 

do  50  i  *  1,1 6 

datran  (i,l)  =  datran  (i,l)  +  dt  temp  (i,l) 

50  datran  (i,2)  *  datran  (i,2)  +  dt  temp  (i,2) 
c 

c  Send  the  start  read  command  again, 
c 

call  waitl  (stat  rg,  H ,  0) 
call  out  (com  reg,  #8e) 
endif 
c 

return 

end 

c 

subroutine  gt  tree 
c 

c- — — — — - --- — — - — — — ■ — - — - » — 

c 

c  This  raitine  gets  the  data  from  the  Transiac 

c  transient  recorders.  The  data  is  placed  into  the  array 

c  trrec  (1000,10): 

c 

c  trrec  (i,2*J-l) ,J*l-5  data 

c  trrec  (i,2*j)  ,J3l-5  square  of  data  (for  error  analysis) 

c 


common  /  data  /  atten  (20),  datran  (16,2),  trrec  (1000,10), 
c  freq  ( 1000 ,2),  data  ( 100,10) 

COMMON  /U  VAR  /  N  U  VAR,  0  VAR  (150 ) 
dimension  ndata  (1000) 

do  100  J  a  1,5 

if  (uvar(l?+j)  ,le.  0.0)  go  to  100 

n  *  int  (uvar  (66+j)) 

nx  »  0 

nq  *  0 

nd  a  0 

ne  »  0 


Test  the  LAM  to  see  if  the  transient  recorder  data 
is  ready  to  be  read  by  the  computer. 


call  dmai  (n,2,0,ndata(l) ,ne) 
if  (ne  .ne.  0)  then 

write  (*,'("  Error  number  *  * i2 *  *  while  reading  transient  ' ' 
c  "recorder  number  "i2 /"  Ho  data  was  recorded.")')  ne,  J 
go  to  100 
endif 

do  20  i  *  I,int(uvar(l7+J ) ) 

tr  rec  (i,2*j-l)  =  tr  rec  (i,2*J-l)  +  float  (ndata(i)) 

tr  rec  (i,2*j)  =  tr  rec  (i,2*j)  +  float(ndata( i) )*float(ndata( i) ) 

Restart  the  transient  recorder  sampling  and  set 
up  the  LAM  again. 

call  camo  (n,9 ,0 ,nd,nq,nx) 

if  (nq  .ne.  l)  write  (*,'("  0.  =  "iit-"  while  attempting  " 
c  "to  start  sampling  for  transient  recorder  "i2)')  nq,  i 
call  camo  (n,26,0 ,nd,nq,nx) 

if  (nq  .ne.  l)  write  (*,'("  Q  *  "iU"  while  enabling  the  " 
c  "LAM  for  transient  recorder  "i2)')  nq,  i 
continue 


return 


data 

data 


segment  public  'data' 
ends 


dgroup 

code 


public 

ittinr 


exit: 


group  data 
segment  ' code ' 

assume  csrcode,  ds: dgroup*  ss: dgroup 


ittinr 
proc  far 
push  dx 
mov  ah,6h 
mov  dl.Offh 
int  21h 
cmp  al,0h 
Jz  exit 

mov  ah, 6h 
mov  dl,al 
int  21h 

cmp  al,fl 
Jnz  exit 

mov  dl,32 
int  21h 
mov  dl,8 
int  21h 

mov  ah, Oh 
pop  dx 
ret 
endp 


; don't  check  for  c 

;get  character  from  buffer 

;al  *  0  means  no  characters 


•.print  the  character 


;is  this  character  a  del? 

;  if  not,  exit 

; write  space  over  deleted  char. 
;move  cursor  back  a  space  again 


ittinr 


Subroutine  dtinpl  (data) 

This  subroutine  gets  the  data  from  the  Data  Translation 
board  and  puts  it  into  the  data  array 
data  (l6,2).  The  data  is  in  data  (i,l)  and  the 
square  of  the  data  is  in  data  (i,2). 

This  routine  is  written  to  interface  with  the  PICAX 
program  by: 

Tom  Hargreaves 
JAYCOR 

205  S.  Whiting  St. 

Alexandria.  VA  2230U 


Last  update: 


August  6,  19^5 


data 

segment  public  'data' 
base_ad  dv  02ech 
com_reg  dw  02edh 
stat_rg  dw  02edh 
dat_reg  dw  02ech 
mem  dw  ? 

data 

ends 

dgroup 

group  data 

code 

segment  ' code ' 

assume  cs:code,  ds: dgroup. 

ss : dgroup 

public 

dtinpl 

dtinpl 

proc  far 
push  bp 
tnov  bp,sp 

;  Get 

the  inpit  from  the  port  first, 
les  bx,  dword  ptr  t"bp+*61 
mov  cx,l6 

input_loop: 

push  cx 
call  wait2 
pop  cx 

mov  dx,dat__reg 
mov  ax,0 

in  al,dx  ;Get 

the  low  data  byte. 

mov  mem, ax  ;Store  it  in  mem. 

push  cx 
call  wait2 
pop  cx 

mov  dx,dat_reg 
mov  ax,0 

in  al,dx  ;Get 

mov  ah.al 

the  high  data  byte 

mov  al,0 

add  mem, ax  ; Total  the  data  value  in  mem 

;  Square  the  data  value  and  store  as  floating  point  variables 
fild  mem 
fid  st  [0] 
fail  st[l!  ,st [o] 
fstp  dword  ptr  es:[bx! 
fstp  dword  ptr  es:[bx+6M 
fwait 
add  bx,k 
loop  input_loop 
mov  sp,bp 
pop  bp 
ret  OUh 
dtinpl  endp 

proc  near 
aov  dx, stat_rg 
mov  ax, Oh 
in  al,dx 
mov  cx,5 
and  cl,al 
mov  ch,0 
cmp  cx,0 
Jle  next_in 
ret 

vait2  endp 


wait2 

next  in: 


data 

data 


segment  public  ’data’ 
ends 


dgrcup 

code 


public 

vaitl 


next  in: 


group  data 
segment  ' code ' 

assume  cstcode,  dsrdgroup,  ss:dgroup 

waitl 
proc  far 
push  bp 
mov  bp,sp 

les  bx,  dvord  ptr(bp+lM 
mov  dx,es:fbxl 
mov  ax, Oh 
in  al,dx 

les  bx, dvord  ptr[bp+6] 
mov  cx,es: (bx! 
xor  al,cl 

les  bx, dvord  ptr[bp+10] 

mov  cx,es:  (bx! 

and  cl,al 

mov  ch,0 

cmp  cx,0 

Jle  next_in 

mov  sp,bp 

pop  bp 

ret  Och 

vaitl  endp 

code  ends 


segment  public  Mata' 
ends 

group  data 
segment  ' code ' 

assume  cstcode,  ds:dgroup,  ssrdgroup 
inp 

proc  far 
push  bp 
mov  bp,sp 

les  bx,  dword  ptr[bp+61 
mov  dx,es: Ibx] 
mov  ax, Oh 
in  al,dx 
mov  sp,bp 


data 

data 

dgroup 

code 


public 

out 


end 


segment  public  'data' 
ends 

group  data 
segment  'code' 

assume  cs:code,  ds: dgroup,  ss: dgroup 
out 

proc  far 
push  bp 
bov  bp,sp 

les  bx,  dvord  ptr[bp+10) 

mov  dx,es:(bx] 

les  bx, dvord  ptr(bp+^] 

mov  al,es: (bx) 

out  dx,al 

mov  sp,bp 

pop  bp 

ret  08h 

out  endp 

code  ends 
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